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

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

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

此方法支持：被合并的扩展名为“.xls”和“.xlsx”的工作簿、合并中可多次选择不同文件夹下的工作簿。

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

在该文件夹中，新建立一个新的Excel工作簿文件。打开新建的Excel工作簿文件，按Alt+F11或者将鼠标移动到下方工作表名称sheet1上右键，选择查看代码。

在弹出的代码编辑窗口中（如下图）粘贴以下代码（如果没有出现直接复制代码的面板等时，需要按Ct rl+R或点菜单栏中“视图”中的“工程资源管理器”，再双击出现在左上方的“工程–VBAProject”中的“Sh eet1”，即可打开代码窗口；宏代码应粘贴到除ThisworkBook外的工作表中）：

Sub CombineWorkbooks()

'Source code from the Internet for free

'Daxin CPA Guangdong Branch Hoohurtle modified on July 27, 2014

Dim FilesToOpen

Dim x As Integer

On Error GoTo ErrHandler

Application.ScreenUpdating = False

Extension1:

FilesToOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel 97-2003工作簿文件(*.xls),*.xls", MultiSelect:=True, Title:="请选择待合并的工作簿文件")

If TypeName(FilesToOpen) = "Boolean" Then

MsgBox "没有选中Excel 97-2003工作簿文件"

GoTo Extension2

End If

x = 1

While x <= UBound(FilesToOpen)

Workbooks.Open Filename:=FilesToOpen(x)

Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

x = x + 1

Wend

Extension2:

FilesToOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel工作簿文件(*.xlsx),*.xlsx", MultiSelect:=True, Title:="请选择待合并的工作簿文件")

If TypeName(FilesToOpen) = "Boolean" Then

MsgBox "没有选中Excel工作簿文件"

GoTo Continue

End If

x = 1

While x <= UBound(FilesToOpen)

Workbooks.Open Filename:=FilesToOpen(x)

Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

x = x + 1

Wend

Continue:

Dim Msg$, Style&, Title$, Continue&

Msg = "是否继续添加其他文件夹中的Excel工作簿文件？"

Style = vbYesNo + vbDefaultButton2

Title = "是否继续添加其他工作簿"

Continue = MsgBox(Msg, Style, Title)

If Continue = vbYes Then

GoTo Extension1

Else

GoTo Over

End If

Over:

ExitHandler:

Application.ScreenUpdating = True

Exit Sub

ErrHandler:

MsgBox Err.Description

Resume ExitHandler

End Sub

接着按F5或点菜单栏中“运行”中的“运行子过程/窗体”（或“运行子过程/用户窗体”，因Excel版本不同而出现差异），此时会提示你选择要合并的文件（此时你可以通过按下Ctrl键单击的方法选择多个工作簿，或按“Ctrl + A”选择全部工作簿），它会使用代码在你所选择的工作簿列表中循环，打开每个工作簿并将其中的工作表移动到工作簿的末尾。在将工作表添加到工作簿末尾的过程中，Excel会复制工作表的名称并自动根据检测结果附加(2)、(3)等数字编号。工作簿中与其他工作表相关的任何公式也会自动更新的新的名称。

然后将“代码编辑窗口”中的代码清空（以免产生宏安全提示），并将合并后得到的工作秒簿保存即可。

请考虑Excel兼容性问题，尽量在Office2007以上版本的Excel中操作，如果在Excel2003中操作时，必要时请安装“OFFICE2003兼容2007的补丁包”（FileFormatConverters.exe版本号12.0.6500.5000），必要时请考虑工作簿中的行数与列数等因素后再确定合适的方案，例如其中有工作簿中含有超过256列的工作表时，需要在Office2007以上版本的Excel中操作并保存成扩展名为“.xlsx”的工作簿，以免丢失数据等；合并前请备份源工作簿。