使用vba合并多个excel工作簿(3种形式)

《使用vba合并多个excel工作簿(3种形式)》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

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

2、eNameAsStringDimwbAsWorkbookDimwsAsObject '包含工作簿的文件夹,可根据实际修改ConststrFileDirAsString="D:示例数据记录" Application.ScreenUpdating=False Setwb=Workbooks.Add(xlWorksheet)strFileName=Dir(strFileDir&"*.xls*") DoWhilestrFileName<>vbNullStringDimwbOrigAsWorkbook

3、SetwbOrig=Workbooks.Open(Filename:=strFileDir&strFileName,ReadOnly:=True)strFileName=Left(Left(strFileName,Len(strFileName)-4),29) ForEachwsInwbOrig.Sheetsws.CopyAfter:=wb.Sheets(wb.Sheets.Count)IfwbOrig.Sheets.Count>1Thenwb.Sheets(wb.Sheets.Count).Na

4、me=strFileName&ws.IndexElsewb.Sheets(wb.Sheets.Count).Name=strFileNameEndIfNext wbOrig.CloseSaveChanges:=False strFileName=Dir Loop Application.DisplayAlerts=Falsewb.Sheets(1).DeleteApplication.DisplayAlerts=True Application.ScreenUpdating=True Setwb=

5、Nothing EndSub2.下面是合并多个Excel工作簿的另一种情形，也是《ExcelVBA实战技巧精粹》中<技巧91：汇总多个工作簿的工作表>所介绍的方法，即合并汇总。有四个工作簿，分别为：汇总工作簿.xls、一月.xls、二月.xls、三月.xls，其中一月.xls、二月.xls、三月.xls均只含有一张工作表且工作表中的数据均自单元格A1开始，现在要求将它们合并至“汇总工作簿.xls”中。在“汇总工作簿.xls”中打开VBE，并输入下列代码：SubConsolidateWorkbook

6、()DimRangeArray()AsStringDimbkAsWorkbookDimshtAsWorksheetDimWbCountAsIntegerWbCount=Workbooks.CountReDimRangeArray(1ToWbCount-1)ForEachbkInWorkbooks'在所有工作簿中循环IfNotbkIsThisWorkbookThen'非代码所在工作簿Setsht=bk.Worksheets(1)'引用工作簿的第一个工作表i=i+1RangeArray(i)="'["

7、&bk.Name&"]"&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)EndIfNextWorksheets(1).Range("A1").Consolidate_RangeArray,xlSum,True,TrueEndSub3.下面是汇总多个工作簿的又一种情形，也是一名网友提出的问题：在同一文件夹中有多个工作簿，其中有一个用于汇总的工作簿，要求将除该汇总工作簿外的其它工作簿中的第一张工作

8、表的数据汇总到该汇总工作簿中。代码如下：SubUnionWorksheets()Application.ScreenUpdating=FalseDimljAsStringDimdirnameAsStringDimnmAsString lj=ActiveWorkbook.Pathnm=ActiveWorkbook.Namedirname=Dir(lj&"*.xls*") Cells.Clear DoWhiledirname<>""Ifdirname<>nmThenWorkbooks