在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 |