夜雨聆风
再也不用手动复制粘了!一键批量合并 Excel 多个工作表 / 工作簿
再也不用手动复制粘了！一键批量合并Excel多个工作表/工作簿
开篇
不知道你有没有遇到过这种情况： 月底做业绩汇总，每个分公司交上来一个Excel文件，打开一看每个文件里还有好几个分区域的表，所有表结构完全一样，就是数据不一样🥹
总不能几十上百个表，一个个打开选数据复制粘贴吧？手都要粘住不说，复制错一行半天都找不出来，上次我同事几十个表合并，硬生生弄了一下午，最后还得重新核对，整个人都emo了…
其实这种同结构数据批量汇总的活，完全可以交给Excel自己干，今天就给大家分享一个我一直在用的VBA工具，不管是当前文件里多个工作表，还是文件夹里几十个独立Excel，点一下鼠标，分分钟帮你汇总完，准确率100%👍
解决方案
这个工具支持两种最常见的汇总场景：
-
当前工作簿内汇总：同一个Excel文件里，多个结构相同的工作表合并到一张总表 -
跨工作簿汇总：一个文件夹里放了N个Excel文件，所有文件里的所有工作表，合并到一张总表
核心思路其实很简单：
👉 先让你选择合并模式，输入表头行数（很多表格表头不止1行，工具也能完美适配）
👉 自动创建（或清空）汇总总表，避免手动新建出错
👉 依次遍历每一个文件/工作表，自动跳过空表和汇总总表本身
👉 最后自动调整列宽，告诉你一共合并了多少行数据，搞定！
代码实现
'========================================
' 功能说明：批量合并多工作表/多工作簿同结构数据到总表
' 适用场景：1. 当前工作簿内多个结构相同的工作表合并汇总
' 2. 指定文件夹下多个结构相同的Excel工作簿合并汇总
' 作者：宏蜘蛛
'日期：2026-03-27
'========================================
Option Explicit
Sub 批量数据合并汇总()
' ---------------------------
' 变量声明区域
' ---------------------------
Dim wsSummary As Worksheet ' 汇总总表对象
Dim wsSource As Worksheet ' 源数据表对象
Dim wbSource As Workbook ' 源工作簿对象
Dim lngHeaderRows As Long ' 表头行数
Dim lngSumLastRow As Long ' 总表最后一行行号
Dim intMergeMode As VbMsgBoxResult ' 合并模式选择
Dim strFolderPath As String ' 多工作簿合并时的文件夹路径
Dim strFileName As String ' 遍历的文件名
Dim blnFirstCopy As Boolean ' 是否是第一次复制（用于复制表头）
Dim lngTotalCount As Long ' 累计汇总数据行数
' ---------------------------
' 程序初始化与环境设置
' ---------------------------
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
blnFirstCopy = True
lngTotalCount = 0
' ---------------------------
' 用户参数输入与验证
' ---------------------------
intMergeMode = MsgBox("请选择合并模式：" & vbCrLf & "是 = 合并指定文件夹下的多个工作簿" & vbCrLf & "否 = 合并当前工作簿内的多个工作表", vbYesNoCancel + vbQuestion, "合并模式选择")
If intMergeMode = vbCancel Then GoTo ExitHandler
lngHeaderRows = Application.InputBox("请输入数据表的表头行数（例如表头占1行则输入1）：", "参数输入", 1, Type:=1)
If lngHeaderRows < 1 Then
MsgBox "表头行数必须是大于0的正整数，程序退出", vbExclamation
GoTo ExitHandler
End If
' ---------------------------
' 创建/清空汇总总表
' ---------------------------
On Error Resume Next
Set wsSummary = ThisWorkbook.Worksheets("汇总总表")
On Error GoTo ErrorHandler
If wsSummary Is Nothing Then
Set wsSummary = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
wsSummary.Name = "汇总总表"
Else
wsSummary.Cells.Clear
End If
lngSumLastRow = 1
' ---------------------------
' 分支1：多工作簿合并逻辑
' ---------------------------
If intMergeMode = vbYes Then
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择存放待合并Excel文件的文件夹"
If .Show <> -1 Then GoTo ExitHandler
strFolderPath = .SelectedItems(1) & "\"
End With
strFileName = Dir(strFolderPath & "*.xls*")
Do While strFileName <> ""
If strFileName <> ThisWorkbook.Name Then
Application.StatusBar = "正在处理文件：" & strFileName
On Error Resume Next ' 单个文件出错时跳过继续
Set wbSource = Workbooks.Open(Filename:=strFolderPath & strFileName, ReadOnly:=True, UpdateLinks:=False)
If Err.Number <> 0 Then
Err.Clear
Application.StatusBar = "跳过无法打开的文件：" & strFileName
GoTo NextFile
End If
On Error GoTo ErrorHandler
For Each wsSource In wbSource.Worksheets
Call 处理单表合并(wsSource, wsSummary, lngHeaderRows, blnFirstCopy, lngSumLastRow, lngTotalCount)
Next wsSource
wbSource.Close SaveChanges:=False
Set wbSource = Nothing
End If
NextFile:
strFileName = Dir
Loop
' ---------------------------
' 分支2：当前工作簿多工作表合并逻辑
' ---------------------------
Else
For Each wsSource In ThisWorkbook.Worksheets
If wsSource.Name <> wsSummary.Name Then
Application.StatusBar = "正在处理工作表：" & wsSource.Name
Call 处理单表合并(wsSource, wsSummary, lngHeaderRows, blnFirstCopy, lngSumLastRow, lngTotalCount)
End If
Next wsSource
End If
' ---------------------------
' 完成提示
' ---------------------------
MsgBox "汇总完成！共汇总有效数据 " & lngTotalCount & " 行", vbInformation, "操作成功"
If Not wsSummary.UsedRange Is Nothing Then wsSummary.UsedRange.EntireColumn.AutoFit
ExitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
Set wsSummary = Nothing
Set wsSource = Nothing
Set wbSource = Nothing
Exit Sub
ErrorHandler:
MsgBox "程序运行出错！" & vbCrLf & "错误号：" & Err.Number & vbCrLf & "错误描述：" & Err.Description, vbCritical
Resume ExitHandler
End Sub
'========================================
' 辅助子过程：处理单个工作表的数据合并（使用 Copy 方法，避免数组类型问题）
'========================================
Private Sub 处理单表合并(ByVal wsSource As Worksheet, ByVal wsSummary As Worksheet, _
ByVal lngHeaderRows As Long, ByRef blnFirstCopy As Boolean, _
ByRef lngSumLastRow As Long, ByRef lngTotalCount As Long)
Dim lngSourceLastRow As Long, lngSourceLastCol As Long
Dim rngHeader As Range, rngData As Range
Dim lngDataRows As Long
' 获取源表有效数据的最后一行和最后一列
lngSourceLastRow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
lngSourceLastCol = wsSource.Cells(lngHeaderRows, Columns.Count).End(xlToLeft).Column
' 排除空表
If lngSourceLastRow <= lngHeaderRows Then Exit Sub
' 第一次复制时复制表头
If blnFirstCopy Then
Set rngHeader = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lngHeaderRows, lngSourceLastCol))
' 直接复制表头到汇总表第一行
rngHeader.Copy Destination:=wsSummary.Cells(1, 1)
blnFirstCopy = False
lngSumLastRow = lngHeaderRows + 1
End If
' 复制数据部分
Set rngData = wsSource.Range(wsSource.Cells(lngHeaderRows + 1, 1), wsSource.Cells(lngSourceLastRow, lngSourceLastCol))
lngDataRows = rngData.Rows.Count
' 直接复制数据到汇总表末尾
rngData.Copy Destination:=wsSummary.Cells(lngSumLastRow, 1)
' 更新总表最后一行和累计行数
lngTotalCount = lngTotalCount + lngDataRows
lngSumLastRow = lngSumLastRow + lngDataRows
End Sub
来给大家说几个关键的设计点，哪怕是新手也能放心用：
✅ 自动适配各种表头：不管你表头是1行还是3行，输入对应行数就行，不用改代码
✅ 自动跳过空表：碰到没有数据的空表，直接忽略不会报错
✅ 自动恢复Excel设置：运行结束后会把Excel的显示、计算设置改回默认，不会影响你后续操作
使用步骤
刚接触VBA的朋友也不用怕，跟着步骤一步步来就行：
-
打开Excel，启用开发工具如果你的Excel顶部没有「开发工具」选项卡，可以点击：文件→选项→自定义功能区，勾选「开发工具」确定就出来了
-
打开VBA编辑器插入模块点击「开发工具」→「Visual Basic」（或者直接按快捷键
Alt+F11），在左侧右键点击你的当前文件，选择「插入」→「模块」 -
粘贴代码把上面的整段代码复制粘贴到弹出的空白模块窗口里，然后关闭VBA编辑器就行
-
运行程序点击「开发工具」→「宏」（或者直接按快捷键
Alt+F8），在弹出的宏列表里选中「批量数据合并汇总」，点击「执行」 -
按提示选择参数
-
第一步选模式：点击「是」就是合并文件夹里的多个工作簿，点击「否」就是合并当前文件的多个工作表 -
第二步输入表头行数，默认是1，直接点确定就是1行表头，有几行就输几行 -
如果选了多工作簿合并，接下来会弹出窗口让你选择存放待合并文件的文件夹，选好点确定就行
然后就等着程序跑就行，跑完会弹出提示告诉你一共合并了多少行数据，一张干干净净的汇总总表就出来了✨
注意事项
❗ 待合并的所有工作表/工作簿，表头结构必须完全一致（列顺序、列数量都要一样），不然汇总出来会错位
❗ 多工作簿合并的时候，请把存放待合并文件的文件夹里，不要放其他不需要合并的Excel文件，程序会自动遍历文件夹里所有Excel
❗ 这个代码文件本身需要保存为「Excel 启用宏的工作簿(*.xlsm)」格式，不然代码会丢失
❗ 如果运行提示宏被禁用，只需要在Excel顶部的安全警告那里，点击「启用内容」就可以了
结语
其实Excel里很多重复机械的工作，都可以用几行代码解放双手，原来几小时的活，现在一分钟就能搞定，还不出错，把时间省下来摸鱼喝奶茶不好吗😉
关注公众号「宏蜘蛛」，获取更多实用Excel自动化工具！点击阅读原文获取代码。