实用VBA：5.批量汇总工作簿、合并工作表

1.需求范例

设想你是一名部门内勤人员，负责定期汇总格式化的表格数据，例如月度报表、周报表、日报表等。收到的文件或者自己积累的文件往往是这样的。

需要将这些表格汇总到一起。少了还好，多花几分钟逐个文件打开CTRL+C、CTRL+V。。。点个几十、几百次，在手指抽筋之前也就搞好了。如果是一百单八将每人一个表呢？如果是全校学生信息表每人一个表呢？如果是马拉松选手信息表每人一个表呢？如果是银河系行星信息表每星一个表呢？

2.基本思路

格式化的表格数据汇总，特点是每个表格字段相同、排序一致、数据量不等、文件数量多。就可以使用VBA批量按顺序打开多个文件，分别复制多个文件中的表格到同一个文件中，实现文件的汇总；采用循环的方式，分别复制各个表中有数据的区域，以追加的方式粘贴到同一个表中，即实现了对多个工作表内容的合并。

3.VBA实现

合并工作簿

Option Explicit

Sub 合并工作簿()

    '定义文件变量

    Dim filestoopen, ft

    Dim wk As Workbook

    '文件数量变量

    Dim x As Integer

    '关闭屏幕刷新

    Application.ScreenUpdating = False

    '选择需要合并的文件

    filestoopen = Application.GetOpenFilename(filefilter:="MIc(*.xlsx), *.xlsx", MultiSelect:=True, Title:="请选择需要合并的文件")

    '未选定文件时进行提示

    If TypeName(filestoopen) = "boolean" Then

        MsgBox "未选定文件。"

    End If

    '初始化

    x = 1

    

    '逐一打开选定的工作簿，将每个工作簿的第一个工作表复制到当前工作簿中

    While x <= UBound(filestoopen)

        Set wk = Workbooks.Open(Filename:=filestoopen(x))

        wk.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

        wk.Close SaveChanges:=False

        Set wk = Nothing

        x = x + 1

    Wend

    

    '打开屏幕刷新

    Application.ScreenUpdating = True

    MsgBox "合并完成"

End Sub

汇总工作表

Option Explicit

Sub 汇总工作表()

    Dim j As Integer

    Application.ScreenUpdating = False

    

    For j = 1 To Sheets.Count

        If Sheets(j).Name <> ActiveSheet.Name Then

            Sheets(j).UsedRange.Copy Cells(Range("A65536").End(xlUp).Row + 1, 1)

        End If

    Next

    

    Range("A1").Select

    '打开屏幕刷新

    Application.ScreenUpdating = True

End Sub

4.运行效果

通过运行合并工作簿的代码，完成后效果如图

运行合并工作表代码后，可以看到各个月份的数据已一键汇总到Sheet1表中。