我有超过5 个具有相同格式的Excel文件，它们的列标题相同，并且都放置在同一文件夹，有什么快速的方法将它们合并到一个单独的Excel文件的一个工作表中？
我有超过5 个具有相同格式的Excel文件，它们的列标题相同，并且都放置在同一文件夹，有什么快速的方法将它们合并到一个单独的Excel文件的一个工作表中？
假设工作簿文件结构如下所示。
其中，在文件夹“要合并的工作簿文件”中，有3个示例工作簿文件“测试1.xls、测试2.xls、测试3.xls”，将它们合并到工作簿“合并.xls”中。
在“合并.xls”工作簿中，有三个工作表。其中，“设置”工作表中的单元格B2中的数据为每个工作簿中想要合并的工作表名，这里假设每个工作簿中的工作表名相同；单元格B3为要合并的数据开始的行号。
在“导入工作簿名”工作表中将放置合并的工作簿的名称。
“合并工作表”就是我们要放置合并的数据的工作表。
完整的VBA代码如下：
‘ 放置导入工作簿名称的工作表
Private Const importedSheet AsString = “导入工作簿名”
‘放置合并数据的工作表
Private Const combinedSheet AsString = “合并工作表”
‘ 放置导入工作簿名称的行号
Private importPtr As Long
Sub main()
Dim response As Variant
response = MsgBox(“想要运行合并程序吗?” & vbCr & _
“这将擦除” & combinedSheet & “工作表中已前合并的数据”, _
vbYesNoCancel + vbDefaultButton3 +vbQuestion, “合并处理”)
If response = vbYes Then
Call selectXls
End If
End Sub
Private Sub selectXls()
‘ 合并数据的工作簿
Dim thisWb As Workbook
‘ 包含工作簿完整路径和文件名的数组
Dim xlsFiles As Variant
‘ 当前的工作簿文件路径和文件名
Dim xls As Variant
‘ 工作簿文件中(通用的)工作表名
Dim xlsCommonSheet As String
‘ 复制数据开始的行号
Dim startRowCopy As Long
‘ 粘贴数据开始的行号
Dim pastePtr As Long
On Error GoTo genericHandler
‘ 帮助加快代码处理速度
Application.EnableCancelKey = False
Application.Calculation =xlCalculationManual
xlsCommonSheet =Range(“Sheet_Name_to_Combine”)
startRowCopy = Range(“startRow”)
Set thisWb = Workbooks(ThisWorkbook.Name)
xlsFiles = Application.GetOpenFilename( _
“Micosoft Excel工作簿(*.xls*), *.xls*”, , _
“选择要合并的文件”, , True)
Application.ScreenUpdating = False
‘ 如果用户没有点击取消按钮
If IsArray(xlsFiles) Then
Sheets(combinedSheet).Select
pastePtr = startRowCopy
‘重置 & 清除数据
importPtr =
thisWb.Sheets(importedSheet).Cells.Clear
thisWb.Sheets(combinedSheet).Rows(pastePtr & “:” &Application.Rows.Count).Clear
For Each xls In xlsFiles
If thisWb.FullName <> xlsThen
Call processXls(pastePtr, xls,thisWb, xlsCommonSheet, startRowCopy)
End If
Next xls
MsgBox “处理成功”, vb***mation + vbOKOnly,”合并程序”
End If
Exit Sub
genericHandler: ‘ 错误处理
thisWb.Activate
Call resetDefault
MsgBox “错误号: ” & Err.Number & vbCr & _
“错误说明: ” & _
Err.Description, vb***mation +vbOKOnly, _
“合并工作簿错误报告”
End Sub
Private Sub processXls(ByRefpastePtr As Long, ByVal xls As Variant, _
ByVal thisWb AsWorkbook, _
ByVal xlsCommonSheet AsString, ByVal startRowCopy As Long)
‘ 打开的工作簿对象
Dim openWb As Workbook
‘ 工作表中最后一个数据单元格所在的行
Dim lastRowx As Long
‘ 打开工作簿
Workbooks.Open (xls)
Set openWb = Workbooks(ActiveWorkbook.Name)
With openWb.Sheets(xlsCommonSheet)
.Select
lastRowx = lastRow()
If lastRowx > Then
.Rows(startRowCopy &”:” & lastRow).Copy _
thisWb.Sheets(combinedSheet).Range(“A” & pastePtr)
pastePtr = pastePtr + (lastRowx -startRowCopy) + 1
‘ 导入数据的工作簿名
importPtr = importPtr + 1
thisWb.Sheets(importedSheet).Range(“A”& importPtr) = openWb.Name
End If
End With
‘ 关闭工作簿
Workbooks(openWb.Name).CloseSaveChanges:=False
End Sub
Private Function lastRow() AsLong
lastRow =
If WorksheetFunction.CountA(Cells) > Then
‘按行向后搜索
lastRow =Cells.Find(What:=”*”, After:=[a1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
End Function
Private Sub resetDefault()
‘ 重置应用程序屏幕刷新和计算模式
Application.ScreenUpdating = True
Application.Calculation =xlCalculationAutomatic
End Sub
运行main过程，弹出如下所示的对话框。
选择“是”按钮，弹出如下所示的选择文件对话框。
导入到要合并的工作簿所在的文件夹，选择要合并的工作簿文件，单击“打开”按钮。如果一切顺利，则合并数据完成，并弹出如下所示的信息。
我们可以查看结果。在“导入工作簿名”工作表中，列出了已经合并数据的工作簿名，如下所示。
在“合并工作表”工作表中，是合并后的数据，如下所示。
