九乡新闻网马来西亚技术移民:使用VBA合并多个Exce
来源：百度文库 编辑：九乡新闻网 时间：2024/04/29 11:59:58
使用VBA合并多个Excel工作簿
有许多实现Excel工作簿合并的方法，在《将多个工作簿中的数据合并到一个工作簿》中介绍过合并工作簿的示例。下面再列举几个示例，供有兴趣的朋友参考。
例如，需要将多个Excel工作簿中的工作表合并到一个工作簿。这里假设需要合并的工作簿在“D:\示例\数据记录\”文件夹中，含有两个工作簿test1.xls、test2.xls（当然，可以不限于两个），在test1.xls工作簿中含有三张工作表，在test2.xls工作簿中含有两张工作表，现在使用一段VBA代码合并这两个工作簿到一个新工作簿中，合并到新工作簿中的工作表分别以原工作簿名加索引值命名。代码如下：
Sub CombineWorkbooks()
Dim strFileName As String
Dim wb As Workbook
Dim ws As Object
'包含工作簿的文件夹,可根据实际修改
Const strFileDir As String = "D:\示例\数据记录\"
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWorksheet)
strFileName = Dir(strFileDir & "*.xls*")
Do While strFileName <> vbNullString
Dim wbOrig As Workbook
Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)
For Each ws In wbOrig.Sheets
ws.Copy After:=wb.Sheets(wb.Sheets.Count)
If wbOrig.Sheets.Count > 1 Then
wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index
Else
wb.Sheets(wb.Sheets.Count).Name = strFileName
End If
Next
wbOrig.Close SaveChanges:=False
strFileName = Dir
Loop
Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wb = Nothing
End Sub