Excel多文件批量合并？VBA 10秒搞定手动半天的工作量
一句话核心价值点：用不到30行的VBA，把原本要半天复制粘贴的多表合并活儿，10秒收工，让零基础也能一次学会体系化批量处理。
目录
领导甩来一堆表？合并愁到秃
办公室常遇到：2026年1月市场部、销售部、客服部各自交月度报表，几十个文件躺在文件夹里，手动打开、复制、粘贴，眼睛看花还怕漏行。函数公式跨文件抓数得先定义名称，数据透视表合并多表要先建连接，文件一多就卡成PPT。
VBA能一次性把指定文件夹里所有Excel文件的第1个工作表数据抓过来，堆成一个总表，不管文件是xls还是xlsx。
Sub 批量合并同结构表()
Dim 路径 As String, 文件名 As String
Dim 总表 As Worksheet, 数据 As Worksheet
Dim 最后行 As Long, 目标行 As Long
路径 = "D:\2026月度报表\" '改成你的文件夹
文件名 = Dir(路径 & "*.xls*")
Set 总表 = ThisWorkbook.Sheets(1)
目标行 = 1
Do While 文件名 <> ""
If 文件名 <> ThisWorkbook.Name Then
Workbooks.Open 路径 & 文件名
Set 数据 = ActiveWorkbook.Sheets(1)
最后行 = 数据.Cells(data.Rows.Count, 1).End(xlUp).Row
数据.Range("A1").Resize(最后行, 数据.Columns.Count).Copy _
总表.Cells(目标行, 1)
目标行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row + 1
Workbooks(文件名).Close False
End If
文件名 = Dir
Loop
MsgBox "合并完啦，共" & (目标行 - 1) & "行数据"
End Sub
原理很简单：先用Dir像扫雷一样把文件夹里的Excel文件名一个个找出来，碰到不是当前运行代码的文件就打开，抓它第1张表的全部有数据的区域，贴到总表往下接。Resize保证抓的是连续数据块，End(xlUp)自动找最后一行，不怕表长短不一。这样不用一个个点，代码跑完就齐活。
路径选不对？代码照样找文件
有人会问：文件夹换了咋办？总不能每次改代码吧。手动选文件夹，函数公式做不到，透视表连接也得重新指位置。VBA可以让2026年的你弹个框自己挑文件夹，路径再变也不怕。
Sub 自选路径批量合并()
Dim 路径 As String, 文件名 As String
Dim 总表 As Worksheet, 数据 As Worksheet
Dim 最后行 As Long, 目标行 As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "选存报表的文件夹"
If .Show <> -1 Then Exit Sub
路径 = .SelectedItems(1) & "\"
End With
文件名 = Dir(路径 & "*.xls*")
Set 总表 = ThisWorkbook.Sheets(1)
目标行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row
If 目标行 = 1 And 总表.Cells(1, 1) = "" Then 目标行 = 1 Else 目标行 = 目标行 + 1
Do While 文件名 <> ""
If 文件名 <> ThisWorkbook.Name Then
Workbooks.Open 路径 & 文件名
Set 数据 = ActiveWorkbook.Sheets(1)
最后行 = 数据.Cells(data.Rows.Count, 1).End(xlUp).Row
数据.Range("A1").Resize(最后行, data.Columns.Count).Copy _
总表.Cells(目标行, 1)
目标行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row + 1
Workbooks(文件名).Close False
End If
文件名 = Dir
Loop
MsgBox "搞定了，数据在总表从第1行开始排"
End Sub
这里用了FileDialog弹出文件夹选择框，你点一下就能定路径，后续Dir照常在选中路径里搜文件。If .Show <> -1是判断你没取消选择就退出，防止空跑。这样哪怕2026年你把报表挪到云盘文件夹，也能即选即用，函数公式可没这灵活劲儿。
表结构不同？智能抓同名列
有时候各部门表格列名一样但顺序不同，或者多了几列无关项，函数公式引用列号会错位，透视表合并要求结构严丝合缝。VBA可以按列名识别，只抓需要的列，2026年再乱的表也能对上号。
Sub 按列名合并关键字段()
Dim 路径 As String, 文件名 As String
Dim 总表 As Worksheet, 数据 As Worksheet
Dim 最后行 As Long, 目标行 As Long
Dim 关键列 As Variant, i As Integer, 列号 As Integer
关键列 = Array("日期", "姓名", "业绩") '改成你需要的列名
路径 = "D:\2026月度报表\"
文件名 = Dir(路径 & "*.xls*")
Set 总表 = ThisWorkbook.Sheets(1)
目标行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row
If 目标行 = 1 And 总表.Cells(1, 1) = "" Then
总表.Range("A1").Resize(1, UBound(关键列) + 1).Value = 关键列
目标行 = 2
Else
目标行 = 目标行 + 1
End If
Do While 文件名 <> ""
If 文件名 <> ThisWorkbook.Name Then
Workbooks.Open 路径 & 文件名
Set 数据 = ActiveWorkbook.Sheets(1)
最后行 = 数据.Cells(data.Rows.Count, 1).End(xlUp).Row
For i = 0 To UBound(关键列)
列号 = 0
On Error Resume Next
列号 = Application.Match(关键列(i), data.Rows(1), 0)
On Error GoTo 0
If 列号 > 0 Then
data.Range(data.Cells(2, 列号), data.Cells(最后行, 列号)).Copy _
总表.Cells(目标行, i + 1)
End If
Next i
目标行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row + 1
Workbooks(文件名).Close False
End If
文件名 = Dir
Loop
MsgBox "按列名抓完，缺的列会留空"
End Sub
Match在表头那行找列名位置，找到就把该列数据拷过去，找不到就跳过留空。Array装你要的关键列，想加“部门”“金额”随时往里塞。这样即便2026年财务多加一列“备注”，也不会把数据搅混，透视表可没这本事挑着抓列。
数据有重复？去重顺手清干净
合并后常有一模一样的行，手工删慢还容易漏。函数去重要先辅助列标记，透视表合并完还得再筛。VBA能在合并时同步去重，2026年数据量大也不怕。
Sub 合并并去重()
Dim 路径 As String, 文件名 As String
Dim 总表 As Worksheet, 数据 As Worksheet
Dim 最后行 As Long, 目标行 As Long, r As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
路径 = "D:\2026月度报表\"
文件名 = Dir(路径 & "*.xls*")
Set 总表 = ThisWorkbook.Sheets(1)
目标行 = 1
Do While 文件名 <> ""
If 文件名 <> ThisWorkbook.Name Then
Workbooks.Open 路径 & 文件名
Set 数据 = ActiveWorkbook.Sheets(1)
最后行 = 数据.Cells(data.Rows.Count, 1).End(xlUp).Row
For Each r In data.Range("A2:A" & 最后行)
If Not dict.exists(r.Value & "|" & r.Offset(0, 1).Value & "|" & r.Offset(0, 2).Value) Then
dict.Add r.Value & "|" & r.Offset(0, 1).Value & "|" & r.Offset(0, 2).Value, Nothing
r.Resize(1, 3).Copy 总表.Cells(目标行, 1)
目标行 = 目标行 + 1
End If
Next r
Workbooks(文件名).Close False
End If
文件名 = Dir
Loop
MsgBox "合并去重完成，共" & (目标行 - 1) & "行唯一数据"
End Sub
Dictionary像个快速查重本，把几列关键值拼成唯一键，见过的就不再录。这里示例用A、B、C三列做判断，你可以按需要改拼接的列。函数在多条件去重时得套多层嵌套，透视表要去重得先做出明细再筛选，VBA一步到位。
结果要美化？一键排版更省心
合并完的表可能字体大小不一、边框缺失，看着像草稿。函数公式管不了格式，透视表样式固定。VBA能在最后顺手把2026年的报表排整齐，看着就像精心做的。
Sub 合并后自动美化()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
With ws
.Columns.AutoFit
.Rows.AutoFit
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A1").CurrentRegion.Font.Name = "微软雅黑"
.Range("A1").CurrentRegion.Font.Size = 10
.Rows(1).Font.Bold = True
.Rows(1).HorizontalAlignment = xlCenter
End With
MsgBox "排版完成，可直接交差"
End Sub
AutoFit让列宽行高刚好包住内容，Borders加全框线，Font统一字体字号，首行加粗居中当标题。运行完就是清爽表，手动调要十几分钟，VBA几秒收工。
金句小结：
手动拼表像搬砖，VBA合并像开吊车。
路径会变列会乱，代码眼里只有目标。
去重去杂一次过，格式漂亮不加班。
学一点体系技，重复活儿不再烦。
其实2026年的办公效率，不在死磕函数，而在用体系化小工具把零散动作串成流水线。今天学会批量合并，明天就能触类旁通做更多自动活儿。别怕代码长，咱们拆成乐高块，一块块拼出轻松办公。
更多干货 点我头像进主页，每天更新
