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

kenleong

请各位大大帮忙,

  如何把活页簿(testfile.xlsx)中所有工作表的第2,7,12栏自动复制到一个指定新的活页簿(检查.xlsm)工作表中, 但原有的活页簿(testfile.xlsx)所有工作表中, 不是每个工作表的第2, 或第7, 或第12栏都有数据, 如何设定当第7栏或者第12栏没有数据时, 就自动跳到下一个工作表, 直到把所有工作表的第2,7,12栏的资料复制到新的活页簿工作表中, 谢谢

test.zip (34.66 KB, 下载次数: 2)

2019-7-20 22:19 上传

点击文件名下载附件

hfwufanhf2006

打开文件的路径参数你需要自己修改下，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

kenleong

谢谢你的帮忙

kenleong

如果栏数改为第2,5,8,11,14,17,20合共有7栏有数据, 即相隔3 栏就有数据, 上面的K, S, S1 和 J 要如何更改? 谢谢

hfwufanhf2006

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列.....

kenleong

谢谢你的帮忙