ARTICLE · 1030499
Excel VBA|多个文件,批量合并数据导入到当前表
Excel VBA|多个文件,批量合并数据导入到当前表工作当中，避免不了进行数据导入，人工操作复制粘贴作业繁琐，VBA可以帮你快速实现自动化数据处理。 本次分享功能：运行代码，弹出文件选择框，按住 Ctrl 多选Excel文件；第一个文件复制表头，其余文件只追加数据行，不再重复带表头；只读打开源文件，带错误捕获，出错不中断、提示哪个文件异常；合并到当前激活工作表。 vba Sub 多选文件批量合并数据() Dim fd As FileDialog Dim selectedItem As Variant Dim wbSource As Workbook Dim wsSource As Worksheet Dim wsDest As Worksheet Dim lastR_Src As Long, lastC_Src As Long Dim lastR_Dest As Long Dim blnFirst As Boolean Dim cntFile As Long, cntRow As Long Dim errMsg As String '===== 配置区，按需修改 ===== Const SourceSheetName As String = "Sheet1" '源文件读取哪个工作表 '=========================== On Error GoTo ErrHandle Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Set wsDest = ActiveSheet '合并到当前激活工作表 blnFirst = True cntFile = 0 cntRow = 0 '文件选择弹窗，支持多选 Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "多选需要合并的Excel文件（按住Ctrl多选）" .AllowMultiSelect = True .Filters.Clear .Filters.Add "Excel文件", "*.xls;*.xlsx;*.xlsm" If .Show <> -1 Then MsgBox "未选择任何文件，退出", vbInformation GoTo CleanUp End If End With '循环遍历选中的每一个文件 For Each selectedItem In fd.SelectedItems cntFile = cntFile + 1 Set wbSource = Workbooks.Open(Filename:=selectedItem, ReadOnly:=True) Set wsSource = wbSource.Worksheets(SourceSheetName) '获取源数据范围 lastR_Src = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row lastC_Src = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column If lastR_Src >= 1 Then '目标表最后一行 lastR_Dest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row If blnFirst Then '第一个文件：复制表头+全部数据 wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastR_Src, lastC_Src)).Copy _ wsDest.Cells(lastR_Dest, 1) blnFirst = False cntRow = cntRow + lastR_Src Else '后面文件：跳过第1行表头，只复制数据行 If lastR_Src >= 2 Then wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(lastR_Src, lastC_Src)).Copy _ wsDest.Cells(lastR_Dest + 1, 1) cntRow = cntRow + (lastR_Src - 1) End If End If End If wbSource.Close SaveChanges:=False '关闭源文件，不保存 Next selectedItem MsgBox "合并完成！" & vbCrLf & "一共处理：" & cntFile & " 个文件" & vbCrLf & "导入总行数：" & cntRow, vbInformation CleanUp: Set fd = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True Exit Sub ErrHandle: errMsg = errMsg & "【文件" & cntFile & "】" & selectedItem & vbCrLf & "错误：" & Err.Description & vbCrLf Resume Next '跳过出错文件，继续下一个 Resume CleanUp End Sub 使用步骤 1. 打开你的汇总Excel，按 Alt+F11 打开VBA编辑器 2. 菜单【插入】→【模块】，粘贴全部代码 3. 回到Excel， Alt+F8 ，选中 多选文件批量合并数据 → 执行 4. 在弹窗按住 Ctrl 点选多个需要合并的文件，确定 修改说明（按需调整） 1. SourceSheetName = "Sheet1" ：如果源文件数据在别的工作表名，改成对应的名字，例如 "数据" 2. 如果想要粘贴为数值（不带格式）：把 .Copy 那一行改成 vba .Copy wsDest.Cells(lastR_Dest, 1).PasteSpecial Paste:=xlPasteValues 限制&注意事项 - 所有源文件列结构必须一致（表头顺序相同），否则数据错位 - 密码保护的文件无法打开，会跳过并记录错误 - 合并前建议清空汇总表原有数据，避免新旧数据叠加 （如果你需要其他方式的代码） 🌹专业制作VBA解决工作中的实际问题。 关注留言备注可以发给你： ✅ 数组版（超大文件，不用Copy，速度更快） ✅ 自动增加【来源文件名】一列，标记每条数据来自哪个文件 ✅ 合并完成自动去除重复行 一键导入外部Excel！VBA文件选择器，自动提取数据到当前表 别再只用RANK！Excel多条件排名，业绩产量排序直接套用 做数据汇总必用！最大/最小/排序全套公式，告别手动拉表格