Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 178|回复: 5

[求助] 如何把活頁簿中所有工作表的第2,7,12欄自動复制到一個指定的工作表中

[复制链接]
发表于 2019-7-20 22:20 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
请各位大大帮忙,
  如何把活页簿(testfile.xlsx)中所有工作表的第2,7,12栏自动复制到一个指定新的活页簿(检查.xlsm)工作表中, 但原有的活页簿(testfile.xlsx)所有工作表中, 不是每个工作表的第2, 或第7, 或第12栏都有数据, 如何设定当第7栏或者第12栏没有数据时, 就自动跳到下一个工作表, 直到把所有工作表的第2,7,12栏的资料复制到新的活页簿工作表中, 谢谢
test.zip (34.66 KB, 下载次数: 2)
发表于 2019-7-21 12:37 | 显示全部楼层
打开文件的路径参数你需要自己修改下,C:\Users\Fanyoulin\Downloads\test是我的路径
If Cells([a100000].End(3).Row, 1) > 3 Then
   Range(Cells(4, 1), Cells([a100000].End(3).Row, 1)).ClearContents
End If
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Users\Fanyoulin\Downloads\test\testfile.xlsx")
hs = 4
For i = 1 To wb.Worksheets.Count
    For k = 1 To 3
        s = IIf(k = 1, 2, IIf(k = 2, 7, 12))
        s1 = wb.Worksheets(i).Cells(65000, s).End(3).Row
        If s1 > 4 Then
           For j = 4 To s1
               ThisWorkbook.Worksheets(1).Cells(hs, 1) = wb.Worksheets(i).Cells(j, s)
               hs = hs + 1
           Next j
        End If
    Next k
Next i
wb.Close
Application.ScreenUpdating = True
回复

使用道具 举报

 楼主| 发表于 2019-7-21 21:49 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2019-7-22 16:38 | 显示全部楼层
如果栏数改为第2,5,8,11,14,17,20合共有7栏有数据, 即相隔3 栏就有数据, 上面的K, S, S1 和 J 要如何更改? 谢谢
回复

使用道具 举报

发表于 2019-7-22 17:11 | 显示全部楼层
kenleong 发表于 2019-7-22 16:38
如果栏数改为第2,5,8,11,14,17,20合共有7栏有数据, 即相隔3 栏就有数据, 上面的K, S, S1 和 J 要如何更改?  ...

   For k = 1 To 7
        s = IIf(k=1, 2,IIf(k=2, 5,iif(k=3,8,iif(k=4,11,iif(k=5,14,iif(k=6,17,20))))))
这行代码我没实测,写法与工作表函数if的嵌套是一个意思,如果有错你自己修改下就行了。其他不用改。
k是列数,总共有7列需要执行操作,也就是需要执行7次列循环;
s是具体的列位置,由k来确定具体的列在哪里。k=1,s是第2列,k=2,s就是第5列.....


回复

使用道具 举报

 楼主| 发表于 2019-7-23 19:34 | 显示全部楼层
谢谢你的帮忙
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2019-12-13 08:14 , Processed in 0.062400 second(s), 6 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表