DeepSeek自动合并Excel表格数据，太方便了吧！

前天兰色说了拆分，有分就有合，今天接让DeepSeep帮我们编写合并多个表格内容代码。

兰色规划以下要求：

1、要弹出选取文件窗口

2、可以指定合并的工作表名称，可以输入序号，也可以输入工作表名称。如输入1，合并所有工作簿的第1个工作表。

3、合并数据按上下顺序存放。

根据以上要求，兰色写了下面的提示语：

请帮我用VBA编写合并多个工作簿的数据代码，运行后弹出一个选择窗口，选取多个工作簿后再弹现一个输入工作表名称的窗口，输入内容可以是工作表的序号，1代码第1个工作表，也可以输入工作表的名称。输入名称后把选取多个工作簿的指定工作表数据合并到一个新建的工作簿的工作表中，工作表名称为”合并后"，如果输入的是序号，则用该序号所在的工作表名称，数据上下顺序，表格示题使用第一个工作簿中的工作表的标题，后面不再合并标题

编写完成的代码：

Sub MergeWorkbooks() Dim filePaths As Variant Dim sheetInput As String Dim targetSheetName As String Dim sheetIndex As Integer Dim isIndex As Boolean Dim newWorkbook As Workbook Dim newSheet As Worksheet

' 选择文件（支持多选） filePaths = Application.GetOpenFilename( _ FileFilter:="Excel Files (*.xls*), *.xls*", _ Title:="请选择要合并的工作簿", _ MultiSelect:=True) If Not IsArray(filePaths) Then Exit Sub

' 输入工作表名称或序号 sheetInput = InputBox("请输入工作表名称或序号（例如：1 或 Sheet1）", "工作表选择") If sheetInput = "" Then Exit Sub

' 判断输入类型 isIndex = IsNumeric(sheetInput) If isIndex Then sheetIndex = CInt(sheetInput)

' 处理第一个文件确定目标名称 Dim firstWorkbook As Workbook Set firstWorkbook = Workbooks.Open(filePaths(1)) On Error Resume Next Dim firstSheet As Worksheet If isIndex Then Set firstSheet = firstWorkbook.Worksheets(sheetIndex) If firstSheet Is Nothing Then MsgBox "第一个文件中不存在序号为 " & sheetIndex & " 的工作表" firstWorkbook.Close False Exit Sub End If targetSheetName = firstSheet.Name Else Set firstSheet = firstWorkbook.Worksheets(sheetInput) If firstSheet Is Nothing Then MsgBox "第一个文件中不存在工作表 '" & sheetInput & "'" firstWorkbook.Close False Exit Sub End If targetSheetName = sheetInput End If On Error GoTo 0

' 创建新工作簿 Set newWorkbook = Workbooks.Add Application.DisplayAlerts = False ' newWorkbook.Sheets("Sheet1").Delete newWorkbook.Sheets.Add.Name = "合并后" Application.DisplayAlerts = True Set newSheet = newWorkbook.Sheets("合并后")

' 修正：复制第一个文件的标题和完整数据 firstSheet.rows(1).Copy newSheet.Range("A1") '复制标题 If firstSheet.UsedRange.rows.count > 1 Then Dim lastRow As Long lastRow = firstSheet.cells(firstSheet.rows.count, 1).End(xlUp).Row firstSheet.Range("A2", firstSheet.cells(lastRow, firstSheet.Columns.count)).EntireRow.Copy newSheet.Range("A2") End If firstWorkbook.Close False

' 合并其他文件数据（保持不变） Application.ScreenUpdating = False Dim i As Long, currentWorkbook As Workbook, currentSheet As Worksheet For i = 2 To UBound(filePaths) Set currentWorkbook = Workbooks.Open(filePaths(i)) On Error Resume Next If isIndex Then Set currentSheet = currentWorkbook.Worksheets(sheetIndex) Else Set currentSheet = currentWorkbook.Worksheets(targetSheetName) End If On Error GoTo 0

If Not currentSheet Is Nothing Then Dim dataRange As Range With currentSheet If .UsedRange.rows.count > 1 Then Set dataRange = .Range("A2", .cells(.rows.count, 1).End(xlUp)) dataRange.EntireRow.Copy newSheet.cells(newSheet.rows.count, 1).End(xlUp).Offset(1) End If End With Else MsgBox "文件 " & filePaths(i) & " 中未找到指定工作表，已跳过" End If currentWorkbook.Close False Next i

Application.ScreenUpdating = True newWorkbook.Activate MsgBox "数据合并完成！"End Sub

代码使用方法：

复制代码  - 开发工具 - Visual basic - 插入代码 - 把代码粘到右侧窗口

点运行即可开启合并

如果你想添加到工具栏中以后在所有工作簿中使用，需要把当前的工作簿另存为加载宏，然后再添加自定义功能区命令，详细可以参考前天兰色发的拆分功能的使用。

来看看合并效果吧：

兰色说：有了deepseek，兰色开始变懒了，原来写一天的代码，现在几句话就让deepseek搞定了。也许一个适合所有0基础写代码的时代，也悄然来临了。