使用VBA合并多个Excel工作簿(3种形式)

1、使用 VBA 合并多个 Excel 工作簿 例如，需要将多个 Excel 工作簿中的工作表合并到一个工作簿。 这里假设需要合并的工作簿 在" 示例数据记录”文件夹中，含有两个工作簿test1.xls、test2.xls (当然，可以不限于两个)，在 test1.xls 工作簿中含有三张工作表，在 test2.xls 工作簿中含有两张工作表，现在 使用一段 VBA 代码合并这两个工作簿到一个新工作簿中，合并到新工作簿中的工作表分别 以原工作簿名加索引值命名。代码如下：Sub CombineWorkbooks()Dim strFileName As StringDim wb As Wor

2、kbookDim wsAs Object'包含工作簿的文件夹 ,可根据实际修改示例 数据记录 "Application.ScreenUpdating = FalseSet wb = Workbooks.Add(xlWorksheet)strFileName = Dir(strFileDir& "*.xls*")Do While strFileName<>vbNullStringDim wbOrig As WorkbookSet wbOrig = Workbooks.Open(Filename:=strFileDir&strFil

3、eName, ReadOnly:=True) strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)For Each wsInwbOrig.Sheetsws.Copy After:=wb.Sheets(wb.Sheets.Count)If wbOrig.Sheets.Count> 1 Thenwb.Sheets(wb.Sheets.Count).Name = strFileName&ws.IndexElsewb.Sheets(wb.Sheets.Count).Name = strFileNameEnd IfN

4、extwbOrig.CloseSaveChanges:=False strFileName = DirLoopApplication.DisplayAlerts = Falsewb.Sheets(1).DeleteApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueSet wb = NothingEnd Sub2.下面是合并多个 Excel 工作簿的另一种情形，也是 Excel VBA 实战技巧精粹中 技巧 91：汇总多个工作簿的工作表所介绍的方法，即合并汇总。有四个工作簿，分别为：汇总工作簿 .xls、一月.xls

5、、二月.xls、三月.xls，其中一月.xls、二 月.xls、三月.xls均只含有一张工作表且工作表中的数据均自单元格A1开始，现在要求将它们合并至“汇总工作簿.xls ”中。在“汇总工作簿.xls ”中打开VBE，并输入下列代码：Sub ConsolidateWorkbook()Dim RangeArray() As StringDim bk As WorkbookDim sht As WorksheetDim WbCountAs IntegerWbCount = Workbooks.CountReDimRangeArray(1 To WbCount - 1)For Each bk In

6、Workbooks ' 在所有工作簿中循环If Not bk Is ThisWorkbook Then ' 非代码所在工作簿Set sht = bk.Worksheets(1) '引用工作簿的第一个工作表i = i + 1RangeArray(i) = "'" &bk.Name& "" &sht.Name& "'!" & _sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR

7、1C1)End IfNextWorksheets(1).Range("A1").Consolidate _RangeArray, xlSum, True, TrueEnd Sub3.下面是汇总多个工作簿的又一种情形，也是一名网友提出的问题：在同一文件夹中有多个 工作簿， 其中有一个用于汇总的工作簿， 要求将除该汇总工作簿外的其它工作簿中的第一张 工作表的数据汇总到该汇总工作簿中。代码如下：Sub UnionWorksheets()Application.ScreenUpdating = FalseDim lj As StringDim dirname As StringDi

8、m nm As Stringlj = ActiveWorkbook.Pathnm = ActiveWorkbook.Namedirname = Dir(lj& "*.xls*")Cells.ClearDo Whiledirname<> ""If dirname<> nm ThenWorkbooks.Open Filename:=lj& "" &dirnameWorkbooks(nm).Activate'复制新打开工作簿的第一个工作表的已用区域到当前工作表 Workbooks(dirname).Sheets(1