【VBA案例020】整合工作簿

1
Option Explicit
2

3
Sub 汇总合并工作簿()
4
    Dim shtName
5
    Dim sht As Worksheet
6

7
    For Each sht In ThisWorkbook.Worksheets
8
        shtName = shtName & "," & sht.Name
9
    Next
10

11
    Dim filePath$, fileName As String
12

13
    filePath = ThisWorkbook.Path & "\文件夹\"
14
    fileName = Dir(filePath & "*.xlsx")
15

16
    Dim row_count, thisRow_count
17
    Application.ScreenUpdating = False
18
    Do While fileName <> ""
19
        With Workbooks.Open(filePath & fileName)
20
            For Each sht In .Worksheets
21
                If InStr("," & shtName & ",", "," & sht.Name & ",") > 0 Then
22
                    row_count = sht.[a65536].End(3).Row
23
                    thisRow_count = ThisWorkbook.Worksheets(sht.Name).[a65536].End(3).Row
24
                    sht.Range("a2:e" & row_count).Copy ThisWorkbook.Worksheets(sht.Name).Range("a" & thisRow_count + 1)
25
                Else
26
                    sht.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
27
                    shtName = shtName & "," & sht.Name
28
                End If
29
            Next
30
            .Close False
31
        End With
32
        fileName = Dir
33
    Loop
34
    Application.ScreenUpdating = True
35

36
End Sub