快速合并多个Excel工作簿到一个新的工作簿.doc

《快速合并多个Excel工作簿到一个新的工作簿.doc》由会员上传分享，免费在线阅读，更多相关内容在教育资源-天天文库。

1、快速合并多个Excel工作簿到一个新的工作簿     如果你有大量Excel工作簿需要合并到一起时，要是你手动完成这一工作，也许这个工作可能将花费你一整天的时间。其实要完成这类合并工作，最好的方法是使用宏，这样的话短时间内甚至只需几分钟便可完成。 本文所介绍的技巧将向你说明如何创建这样一个宏，看看如何使用宏来节省你的宝贵时间。此技巧可以应用于MicrosoftExcel2003/2007/2010/2013等版本，只是在弹出VBA代码窗口（MicrosoftVisualBasic窗口、MicrosoftVisualBasicforApplications窗口）时会因Excel版本不同而

2、有所差异。     此方法支持：被合并的扩展名为“.xls”和“.xlsx”的工作簿、合并中可多次选择不同文件夹下的工作簿。    将需要合并的excel工作簿文件放置在一个文件夹中以便于选择（如果放于不同文件下，则需要在提示“是否继续添加其他文件夹中的Excel工作簿文件？”时选择“是”），这些工作簿总数适宜100个左右或以下，不要求工作簿中只包含一个单独的工作表，允许部分工作簿包含多个工作表（以电脑配置或者说电脑可用资源为上限，没有固定的值，如果处理过多时excel没有响应或电脑假死甚至死机时，请减少待合并工作簿的数量），建议在合并前删除待合并的工作簿中的空工作表。    在该文件

3、夹中，新建立一个新的Excel工作簿文件。 打开新建的Excel工作簿文件，按Alt+F11或者将鼠标移动到下方工作表名称sheet1上右键，选择查看代码。    在弹出的代码编辑窗口中（如下图）粘贴以下代码（如果没有出现直接复制代码的面板等时，需要按Ctrl+R或点菜单栏中“视图”中的“工程资源管理器”，再双击出现在左上方的“工程–VBAProject”中的“Sheet1”，即可打开代码窗口；宏代码应粘贴到除ThisworkBook外的工作表中）：SubCombineWorkbooks()'SourcecodefromtheInternetforfree'DaxinCPAGuangd

4、ongBranchHoohurtlemodifiedonJuly27,2014DimFilesToOpenDimxAsIntegerOnErrorGoToErrHandlerApplication.ScreenUpdating=FalseExtension1:FilesToOpen=Application.GetOpenFilename(FileFilter:="MicrosoftExcel97-2003工作簿文件(*.xls),*.xls",MultiSelect:=True,Title:="请选择待合并的工作簿文件")IfTypeName(FilesToOpen)="Boolean

5、"ThenMsgBox"没有选中Excel97-2003工作簿文件"GoToExtension2EndIfx=1Whilex<=UBound(FilesToOpen)Workbooks.OpenFilename:=FilesToOpen(x)Sheets().MoveAfter:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)x=x+1WendExtension2:FilesToOpen=Application.GetOpenFilename(FileFilter:="MicrosoftExcel工作簿文件(*.xlsx),*.xlsx",

6、MultiSelect:=True,Title:="请选择待合并的工作簿文件")IfTypeName(FilesToOpen)="Boolean"ThenMsgBox"没有选中Excel工作簿文件"GoToContinueEndIfx=1Whilex<=UBound(FilesToOpen)Workbooks.OpenFilename:=FilesToOpen(x)Sheets().MoveAfter:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)x=x+1WendContinue:DimMsg$,Style&,Title$,Contin

7、ue&Msg="是否继续添加其他文件夹中的Excel工作簿文件？"Style=vbYesNo+vbDefaultButton2Title="是否继续添加其他工作簿"Continue=MsgBox(Msg,Style,Title)IfContinue=vbYesThenGoToExtension1ElseGoToOverEndIfOver:ExitHandler:Application.ScreenUpdating=TrueExitSubErrH