使用VBA合并多个Excel工作簿

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

2、 Object包含工作簿的文件夹，可根据实际修改示例数据记录Applicati on. Scree nUpdati ng = FalseSet wb = Workbooks.Add(xlWorksheet)strFileName = Dir(strFileDir & *.xls*)Do While strFileName vbNullStri ngDim wbOrig As WorkbookSet wbOrig = Workbooks.Ope n( File name:二strFileDir & strFileName, ReadO nl y:二True)strFileName = Left(

3、Left(strFileName, Le n(strFileName) - 4), 29)For Each ws In wbOrig.Sheetsws.Copy After:二wb.Sheets(wb.Sheets.Co unt)If wbOrig.Sheets.Cou nt 1 The nwb.Sheets(wb.Sheets.Co un t).Name = strFileName & wsn dexElsewb.Sheets(wb.Sheets.Cou nt).Name = strFileNameEnd IfNextwbOrig.Close SaveCha nges:二FalsestrFi

4、leName = DirApplicatio n.DisplayAlerts = Falsewb.Sheets(1).DeleteApplicatio n.DisplayAlerts = TrueApplicati on. Scree nUpdat ing = TrueSet wb = Nothi ngEnd Sub2.下面是合并多个Excel工作簿的另一种情形，也是Excel VBA实战技巧精 粹中 技巧91:汇总多个工作簿的工作表 所介绍的方法，即合并汇总。有四个工作簿，分别为：汇总工作簿.xls、一月.xls、二月.xls、三月.xls,其 中一月.xls、二月.xls、三月.xls均只

5、含有一张工作表且工作表中的数据均自 xxA1 开始，现在要求将它们合并至 汇总工作簿.xls中。在汇总工作簿.xls中打开VBE并输入下列代码：Sub Co nsolidateWorkbook()Dim Ran geArray() As Stri ngDim bk As WorkbookDim sht As WorksheetDim WbCou nt As In tegerWbCou nt = Workbooks.Cou ntReDim Ran geArray(1 To WbCou nt - 1)For Each bk In Workbooks在所有工作簿中循环If Not bk Is Thi

6、sWorkbook The n 非代码所在工作簿Set sht = bk.Worksheets(l)引用工作簿的第一个工作表i = i + 1Ran geArray(i) = & bk.Name & & sht.Name & ! & _ sht.Ra nge(A1).Curre ntRegio n.Address(Refere nceStyle:=xlR1) End IfNextWorksheets。).Ran ge(A1).Co nsolidate _Ran geArray, xlSum, True, TrueEnd Sub3.下面是汇总多个工作簿的又一种情形，也是一名网友提出的问题：在同一

7、 文件夹中有多个工作簿，其中有一个用于汇总的工作簿，要求将除该汇总工作 簿外的其它工作簿中的第一张工作表的数据汇总到该汇总工作簿中。代码如 下：Sub Un io nWorksheets()Applicati on. Scree nUpdati ng = FalseDim lj As Stri ngDim dir name As Stri ngDim nm As Stri nglj = ActiveWorkbook.Pathnm = ActiveWorkbook.Namedirname = Dir(lj & *.xls*)Cells.ClearDo While dirname If dir name nm ThenWorkbooks.Ope n File name:=lj & & dir nameWorkbooks (nm Activate复制新打开工作簿的第一个工作表的已用区域到当前工作表Workbooks(dir name).Sheets(1).U