在Excel里如何将多个工作簿合并到一个工作簿中
当你必须将多个工作簿合并到一个工作簿时，你遇到过麻烦吗？最让人心烦的就是需要合并的工作簿里有很多张工作表。有人能推荐方法解决这个问题吗？
利用VBA 将多个工作簿合并到一个工作簿中
复杂，高级用户使用
Excel 的专业用户可以使用VBA 将多个工作簿合并到一个主要的工作簿中。你可以按照如下步骤操作：
1. 将需要合并的所有工作簿都 放置在同一个目录下。如图：
2. 打开一个工作簿，其他工作簿将被合并到这个工作簿中。
3. 点击开发工具 >> Visual Basic，Microsoft Visual Basic for applications 窗口将被打开，点击插入 >> 模块，将下面的代码输入模块窗口中：
VBA:将多个工作簿合并到一个工作簿中
|
1
2
3
4
5
6
7
8
9
10
11
12
|
Sub GetSheets() Path = "C:\Users\dt\Desktop\dt kte\" Filename = Dir(Path & "*.xls") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub |
提示：在上面的代码里，你可以将目录路径更换成你自己使用的路径。
4. 然后点击 
按钮运行代码，工作簿里的全部工作表（包括空白工作表）都将被合并到主工作簿里。
注意：这个VBA 代码能将整个工作簿合并到主工作簿中，但是不能 针对指定的工作表进行合并。
利用移动或复制功能将多个工作簿合并到一个工作簿中
如果你只是Excel 新手，除了复制每张工作表里的内容再粘贴到新工作簿和应用移动或复制功能外，也没有其他选择了。应用移动或复制功能能帮你快速地将一张或多张工作表导出或复制到新工作簿里。
1. 打开所有需要合并的工作簿。
2. 在工作表标签栏上选中一个工作簿里的全部工作表名称。按住Ctrl 键或Shift 键，你可以同时选择多个工作表。右键点击工作表名称，从右键菜单里选择移动或复制。
3. 在移动或复制工作表对话框里，在将选定工作表移至工作簿下拉菜单里选择主 工作簿，其他工作簿都将被合并到这个主 工作簿中。然后指定合并工作表的位置。如图：
 |
 |
 |
4.点击确定。选中的工作表都被合并到了主 工作簿里。
5. 重复2-4步，将其他工作簿移到主要的工作簿里。这样，所有打开的工作簿中 的工作表都被合并到了一个工作簿里。如图：
http://www.extendoffice.com/documents/excel/zh-cn-excel/2805-combine-multiple-workbooks.html
实践证明，下面的代码也很有效：(http://www.excelperfect.com/index.php/2009/05/23/mergesomeworkbooks/)
Sub CombineWorkbooks()
Dim strFileName As String
Dim wb As Workbook
Dim ws As Object
'包含工作簿的文件夹,可根据实际修改
Const strFileDir As String = "D:\示例\数据记录\"
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWorksheet)
strFileName = Dir(strFileDir & "*.xls*")
Do While strFileName <> vbNullString
Dim wbOrig As Workbook
Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)
For Each ws In wbOrig.Sheets
ws.Copy After:=wb.Sheets(wb.Sheets.Count)
If wbOrig.Sheets.Count > 1 Then
wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index
Else
wb.Sheets(wb.Sheets.Count).Name = strFileName
End If
Next
wbOrig.Close SaveChanges:=False
strFileName = Dir
Loop
Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wb = Nothing
End Sub
|
