如何将同个文件夹内的多个sheet2页复制可见内容并汇总到汇总表

ruhong18 · 发表于 2019-12-11 16:32

本帖最后由 ruhong18 于 2019-12-20 18:30 编辑

如何将同个文件夹内的多个sheet2页复制可见内容并汇总到汇总表1,2,3，依次类推；

exyantou · 发表于 2019-12-12 22:12

Option Explicit
Sub 汇总表格()
Dim filename$, sheet_name$, arr_filename(1 To 10 ^ 3) As String
Dim filecount%, i%, k%
Dim sh As Worksheet, wb As Object, d As Object, sheetcount_before%
sheetcount_before = ThisWorkbook.Sheets.Count
filename = Dir(ThisWorkbook.Path & "\*.xl*")
Do While filename <> ""
If filename <> ThisWorkbook.Name Then
filecount = filecount + 1
arr_filename(filecount) = filename
filename = Dir
Else
filename = ""
End If
Loop
Set d = CreateObject("scripting.dictionary")
For i = 1 To ThisWorkbook.Sheets.Count
d(Sheets(i).Name) = ""
Next i
Application.ScreenUpdating = False
For k = 1 To filecount
sheet_name = Format(Mid(arr_filename(k), InStr(arr_filename(k), ".") - 1, 2), "00")
If Not d.exists(sheet_name) Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "" & arr_filename(k))
wb.Sheets("sheet2").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = sheet_name
wb.Close False
End If
Next
Application.ScreenUpdating = True
MsgBox "执行完成，本次共更新" & ThisWorkbook.Sheets.Count - sheetcount_before & "个文件", vbInformation
End Sub