大家好，又见面了，我是你们的朋友全栈君。

任务介绍

在日常工作中，我们经常会遇到需要汇总多个表格的数据，将它们合并到一个表格里的情况。虽然复制粘贴大法好，但如果让你汇总几十人填报的个人信息并做成汇总表格，估计你也膜不动了。因此，这一次我们就通过VBA程序完成这个任务，从此妈妈再也不担心我数数到头秃。

程序基本思路

1. 将要合并的Excel文件放到同一个文件夹中；
2. 在文件夹中新建一个Excel文件用于汇总并运行VBA程序；
3. 通过VBA程序获取这个文件夹中所有文件的路径；
4. 依次通过程序自动打开各个文件，并将数据复制粘贴到汇总表中。

VBA编程

1. 文件目录如下：

1. 其中1.xlsx和2.xlsx的内容如下：

1. 打开“合并.xlsm”文件，依次点击【开发工具】→【Visual Basic】，【右键】【插入模块】进入编程页面。

1. 编写如下程序：

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)”后面再说
                    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
        WbN = WbN & Chr(13) & wb.Name '记录一下合并的过的文件的名字，用于最后弹提示框用
        firstFile = False '让它等于False，这样下一个文件就不会复制表头了
        wb.Close False '关闭Excel文件并不保存，用True就是关闭并保存
    End If
    fileName = Dir '这里不给Dir函数传参数会自动使用上面传过的参数，并返回符合要求的下一个文件路径
Range("A1").Select