進入本篇文章之前，可以先思考一下，平常我們在使用Excel的時候，都是怎麼樣建立工作表，以及合併工作表的呢? 說起來，簡單的操作並不複雜，但是如果您的工作需要經常在活頁簿內，將工作表分解，建立成好幾個活頁簿，又或者是活頁簿內的工作表，要回併合成一個檔案的時候，這可能就是個很花費時間的作業。
舉例來說，一家公司底下有好幾個分店，總公司的人員提供一個Excel檔案，裡面有1個工作表，每個月的營收，各分店都要製作Excel資料並寄回總公司，接下來再由總公司的人員將所有的個別檔案合併到一個活頁簿，給上級主管審閱。遇到狀況的時候又要把活頁簿裡的工作表拆成好幾個檔案，再各自寄給各分店人員。不斷的合併分解活頁簿的工作表，如果檔案多到100個，想必負責人員可能光是做這些合併分解檔案，就什麼事都不用做了。當然假設這個檔案是獨立於ERP系統之外，需要個別製作的資料。
實際的工作，可能遠比舉例的內容更加複雜，如果您需要經常大量操作工作表建立合併分解時，不妨可以參考這個範例，希望能給您一個思考的方向。
目錄
前言
話說這個是我有一天在網路上所看到的問題，內容跟前面所舉的例子有點差不多，需要進行工作表的建立合併和活頁簿的工作表分解。雖然平常不會需要大量的工作表處理，但看到有這樣的需求，還是會想要試看看，可以怎麼做。
但說真的，一個活頁簿內有大量的工作表，不管是檔案龐大，更別說裡面如果設定函數、計算，甚至各式各樣的設定，都有可能讓檔案容量過於肥大，操作檔案時，如果電腦配備不好，還有可能發生當機之類的。
以下說明使用Excel 2019 ，版本不同或許有點差異，
但基本上製作的方法差不多是一樣的。
程式最終製作的成果會如下圖。
開始製作程式: 階段1 程式說明
1. 使用手動操作工作表
2. 使用VBA操作工作表程式範例預覽
如何手動建立工作表?
如何手動複製工作表?
如何移動工作表到另外的活頁簿?
關於階段1可參考以下連結影片
開始製作程式: 階段2 製作批次工作表
1. 撰寫程式前的準備
2. 製作批次工作表
3. 效果確認
在這個階段，影片會先說明撰寫程式前，應該注意的那些準備，
重要的是如果想要使用VBA，記得檔名要存為Excel 啟用巨集的活頁簿。
副檔名為 .xlsm ，不然會無法使用巨集。
之後會再進行程式碼的撰寫，最後再進行程式效果的確認。
程式碼
Sub MakeWorksheet()
' 異常處理
On Error GoTo ErrorMsg
' 宣告變數
' count 為儲存格計算用宣告為整數
Dim count As Integer
' lastRow為資料的最後一行,宣告為整數
Dim lastRow As Integer
' 關閉畫面更新
Application.ScreenUpdating = False
' 取得最後一列(Row)的數字
lastRow = Worksheets(1).Range("A1").End(xlDown).Row
' For...Next 迴圈, 從A2到最後一列(Row)
For count = 2 To lastRow
' 在每個新的工作表後, 新增工作表 並設定名稱
Worksheets.Add(After:=Worksheets(count - 1)).Name = Worksheets(1).Range("A" & count).Value
Next
' 開啟畫面更新
Application.ScreenUpdating = True
' 選擇第1個工作表
Worksheets(1).Select
'提示完成
MsgBox "Finish"
Exit Sub
ErrorMsg:
MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & " 錯誤說明 : " & Err.Description
End Sub
關於階段2可參考以下連結影片
開始製作程式: 階段3 批次刪除工作表
1. 批次刪除工作表
2. 效果確認
在這個階段，主要說明如何撰寫批次刪除工作表的方式。
這個部分的重點在於，刪除工作表的迴圈，是從最後一個工作表刪到工作表1，如果是從工作表1開始刪除，程式較不容易撰寫以及容易出錯。
當然如果您想要嘗試另外的方法也是可以的喔。
最後再進行程式撰寫後的效果確認。
程式碼
Sub DeleteWorksheet()
' 異常處理
On Error GoTo ErrorMsg
' 宣告變數
' i 為儲存格計算用宣告為整數,
'並設定初期值為活頁簿的工作表數量
Dim i As Integer: i = Worksheets.count
' 巨集執行時隱藏提示和警告訊息
Application.DisplayAlerts = False
' 關閉畫面更新
Application.ScreenUpdating = False
' Do Until ...Loop 刪除工作表直到工作表1
Do Until i = 1
' 刪除工作表
Worksheets(i).Delete
i = i - 1
Loop
' 巨集執行時開啟提示和警告訊息
Application.DisplayAlerts = True
' 開啟畫面更新
Application.ScreenUpdating = True
' 選擇第1個工作表
Worksheets(1).Select
'提示完成
MsgBox "Finish"
Exit Sub
ErrorMsg:
MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & " 錯誤說明 : " & Err.Description
End Sub
關於階段3可參考以下連結影片
開始製作程式: 階段4 批次工作表轉個別檔案
1. 批次工作表轉個別檔案
2. 效果確認
在這個階段，主要說明如何撰寫批次工作表轉個別檔案的方式。
這個部分的重點在於將每個工作表，一個一個轉為個別檔案。其實就是把手動的方式的操作順序改為VBA程式撰寫，雖然程式的部分較為複雜，可能需要比較多的時間去理解。
最後再進行程式撰寫後的效果確認。
程式碼
Sub WorkSheetToIndividualFile()
' 異常處理
On Error GoTo ErrorMsg
' 宣告變數
' i 為儲存格計算用宣告為整數,
'並設定初期值為活頁簿的工作表數量
Dim i As Integer: i = Worksheets.count
' lastRow為資料的最後一行,宣告為整數
Dim lastRow As Integer
' dataRange為自由型態, 儲存陣列值使用
Dim dataRange As Variant
' 取得最後一列(Row)的數字
lastRow = Range("A1").End(xlDown).Row
' 將執行程式中的活頁簿A2到A11的值指定給dataRange
dataRange = ThisWorkbook.Worksheets(1).Range("A2:A" & lastRow).Value
' 關閉畫面更新
Application.ScreenUpdating = False
' Do Until ...Loop 刪除工作表直到工作表1
Do Until i = 1
' 新增活頁簿
Workbooks.Add
' 目前作用中的活頁簿另存新檔到執行程式的活頁簿路徑下, 名稱為陣列中的值, 副檔名為 xlsx
ActiveWorkbook.SaveAs filename:=ThisWorkbook.path & "\" & dataRange(i - 1, 1) & ".xlsx"
' 執行程式的活頁簿的指定工作表, 移動到目前作用中的活頁簿的工作表1之前
ThisWorkbook.Worksheets(i).Move Before:=ActiveWorkbook.Worksheets(1)
' 關閉檔案並存檔
ActiveWorkbook.Close saveChanges:=True
i = i - 1
Loop
' 開啟畫面更新
Application.ScreenUpdating = True
'提示完成
MsgBox "Finish"
Exit Sub
ErrorMsg:
MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & " 錯誤說明 : " & Err.Description
End Sub
關於階段4可參考以下連結影片
開始製作程式: 階段5 檔案合併回活頁簿
1. 個別檔案合併回活頁簿
2. 效果確認
在這個階段，主要說明如何撰寫個別檔案合併回活頁簿的方式。
這個部分的重點在於，將每一個檔案的工作表合併到活頁簿。但要注意的是，範例程式的設計為，針對每個工作表1，合併到一個檔案中，也就是階段4的延續，跟實際上可能每個檔案都有不同數量的活頁簿的設計不太相同。如果想要一樣的效果，可能就要再追加需要的程式碼，才能符合不同的需求。
最後再進行程式撰寫後的效果確認。
程式碼
Sub MergeSheetsToOne()
' 異常處理
On Error GoTo ErrorMsg
' 宣告變數
' 變數path為字串型態
Dim currentWorkbookPath As String
' 變數filename為字串型態
Dim filename As String
' 變數i為整數型態 , 並設定初期值為1
Dim i As Integer: i = 1
' 變數lastRow 為最後一列Row的數字
Dim lastRow As Integer
' 變數CheckDir為字串型態
Dim CheckDir As String
' 變數 currentProgramSheet為工作表物件
Dim currentProgramSheet As Worksheet
'currentProgramSheet 參照執行程式的活頁簿的工作表1
Set currentProgramSheet = ThisWorkbook.Worksheets(1)
' 執行程式的活頁簿路徑指定給path變數
currentWorkbookPath = ThisWorkbook.path
' dataRange為自由型態, 儲存陣列值使用
Dim dataRange As Variant
' 取得最後一列(Row)的數字
lastRow = Range("A1").End(xlDown).Row
' 將執行程式中的活頁簿A2到A11的值指定給dataRange
dataRange = currentProgramSheet.Range("A2:A" & lastRow).Value
' 關閉畫面更新
Application.ScreenUpdating = False
' For迴圈 確認資料夾內是否有與工作表內名稱相同的檔案
For i = lastRow To 2 Step -1
' 確認執行程式的活頁簿路徑下的檔案
CheckDir = Dir(currentWorkbookPath & "\" & dataRange(i - 1, 1) & ".xlsx")
' 如果找到的檔案名稱與執行程式的活頁簿相同
If CheckDir = dataRange(i - 1, 1) & ".xlsx" Then
' 以唯讀方式開啟該名稱的活頁簿
Workbooks.Open filename:=currentWorkbookPath & "\" & dataRange(i - 1, 1) & ".xlsx", ReadOnly:=True
'目前作用中的活頁簿的工作表1,移動到執行程式的活頁簿的工作表1之後
ActiveWorkbook.Worksheets(1).Move After:=currentProgramSheet
' 活頁簿關閉不存檔
Workbooks(dataRange(i - 1, 1) & ".xlsx").Close saveChanges:=False
' 刪除檔案
Kill currentWorkbookPath & "\" & currentProgramSheet.Range("A" & i).Value & ".xlsx"
Else
' 若找不到則傳回無此檔案
MsgBox "無此檔案: " & dataRange(i - 1, 1) & ".xlsx"
End If
Next
' 開啟畫面更新
Application.ScreenUpdating = True
' 選擇執行程式中的活頁簿的工作表1
currentProgramSheet.Select
' 釋放物件
Set currentProgramSheet = Nothing
'提示完成
MsgBox "Finish"
Exit Sub
ErrorMsg:
MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & " 錯誤說明 : " & Err.Description
End Sub關於階段5可參考以下連結影片
以上就是本次文章所介紹的內容，有興趣再參考看看吧。