多個excel檔案合併到一個檔案中的多個sheet表中

功能：多個excel檔案合併到一個檔案中的多個sheet表中（即一個檔案對應一個sheet表，且只合並每個原始檔的第一個sheet表格）

 

步驟1：把多個excel檔案放到同一個資料夾中

步驟2：在該資料夾中新建一個excel檔案，並開啟

步驟3：在開啟的檔案中sheet上右擊，選擇檢視程式碼

步驟4：在紅框區域輸入程式碼，點選執行即可

 

 

 

程式碼：

 

'功能：把多個excel工作簿的第一個sheet工作表合併到一個excel工作簿的多個sheet工作表，新工作表的名稱等於原工作簿的名稱
Sub Books2Sheets()

'定義對話方塊變數

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)        '新建一個工作簿
Dim newwb As Workbook
Set newwb = Workbooks.Add
With fd
If .Show = -1 Then
'定義單個檔案變數
Dim vrtSelectedItem As Variant
'定義迴圈變數
Dim i As Integer
i = 1
'開始檔案檢索
For Each vrtSelectedItem In .SelectedItems
'開啟被合併工作簿
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
'複製工作表
tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
'把新工作簿的工作表名字改成被複制工作簿檔名，這兒應用於xls檔案，即Excel97-2003的檔案，如果是Excel2007，需要改成xlsx
newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xlsx", "")
'關閉被合併工作簿
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
Set fd = Nothing
End Sub