文科生也能学会的Excel VBA 宏编程入门（三）——合并文件

Sub 合并当前目录下所有工作簿的全部工作表()
Dim filePath, fileName, thisName
Dim wb, cwb As Workbook
Dim WbN As String
Dim G As Long
Dim Num As Long
Dim firstFile As Boolean '用于判断是否第一个文件，第一个文件需要把表头也复制，而后面的不需要
firstFile = True

Application.ScreenUpdating = False '关闭屏幕刷新，这样频繁开关excel文件可以提高速度

filePath = ActiveWorkbook.Path     '合并文件所在文件夹
fileName = Dir(filePath & "\" & "*.xlsx") '给Dir函数传入一个路径通配符，它就还你一个符合的文件路径。其中*为通配符，代表任意字符，例如：C:\*.xlsx，也就是C盘根目录下的所有xlsx文件

thisName = ActiveWorkbook.Name '合并文件的文件名

Set cwb = ActiveWorkbook   '记录下当前激活的excel文件，也就是合并文件。因为后面会同时打开多个excel文件，先记录下来程序才不会弄混不同的文件
cwb.ActiveSheet.UsedRange.Clear '将合并文件的内容清空，还你一个清清白白的汇总表

Num = 0
Do While fileName <> "" '判断是否文件夹里的文件都遍历完了
    If fileName <> thisName Then  '如果该文件不是我们的合并汇总文件，那么就一定是需要合并的文件了
        Set wb = Workbooks.Open(filePath & "\" & fileName) 'Open函数用于打开这个文件，并用wb这个变量记住它，免得程序找不到
        Num = Num + 1
        
            
        For G = 1 To Sheets.Count '从第一个sheet循环到最后一个sheet，这样文件有多个sheet也能合并到汇总文件的相应sheet里面
            If cwb.Sheets.Count < G Then '如果汇总表里sheets数量不够就添加一个
                cwb.Sheets.Add after:=cwb.Sheets(G - 1)
            End If
            
        
            With cwb.Sheets(G) 'with 表达式...end with 就是个偷懒小技巧，...部分可以用“.”表示“表达式.”。所以下面“.Cells”相当于“cwb.Sheets(G)”
                If firstFile Then
                    wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)    'copy函数之前说过了就不再说了，这里usedRange是指sheet中所有用过的单元格，“End(xlUp)”后面再说
                Else
                    wb.Sheets(G).Rows(2 & ":" & wb.Sheets(G).Range("A65536").End(xlUp).Row).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
                End If
            End With
        Next
        
        WbN = WbN & Chr(13) & wb.Name '记录一下合并的过的文件的名字，用于最后弹提示框用
        
        firstFile = False '让它等于False，这样下一个文件就不会复制表头了
        wb.Close False '关闭Excel文件并不保存，用True就是关闭并保存
            
        
    End If
    fileName = Dir '这里不给Dir函数传参数会自动使用上面传过的参数，并返回符合要求的下一个文件路径
    
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub