我有超过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 “处理成功”, vbInformation + vbOKOnly,”合并程序”

End If

Exit Sub

genericHandler: ‘ 错误处理

thisWb.Activate

Call resetDefault

MsgBox “错误号: ” & Err.Number & vbCr & _

“错误说明: ” & _

Err.Description, vbInformation +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过程，弹出如下所示的对话框。

选择“是”按钮，弹出如下所示的选择文件对话框。

导入到要合并的工作簿所在的文件夹，选择要合并的工作簿文件，单击“打开”按钮。如果一切顺利，则合并数据完成，并弹出如下所示的信息。

我们可以查看结果。在“导入工作簿名”工作表中，列出了已经合并数据的工作簿名，如下所示。

在“合并工作表”工作表中，是合并后的数据，如下所示。

阅读全文