【引言】

有的時候我們需要把某個目錄下多個工作薄檔案合併到一個檔案，比如：一個小商店每個月都有一個以月份為名稱的結算表，到了年底，可能需要把它們合成一個以年度為名稱的工作薄，一是精簡檔案，二是方便管理，如何實現？(以下方法均針對需要合併的工作薄中都只有一個工作表)

實現方法一

如果檔名稱是確定的，且有規律,比如合併1,2,3月到一季度,那麼可以先新建一個空白工作薄，錄製一個巨集，把其中一個工作薄中工作表移動/複製到新工件薄中,再修改,此時我們可以得到以下程式碼

Sub 巨集1()
'
' 巨集1 巨集
'

'
    Workbooks.Open Filename:="C:\Users\hp\Desktop\1月.xlsx
 
"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Move After:=Workbooks("工作簿1").Sheets(1)
　　 ActiveWorkbook.SaveAs Filename:="C:\Users\hp\Desktop\一季度.xlsm", FileFormat _:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

然後我們把另外兩個加進來就好,方法是複製並修改程式碼(這種方法對初學者比較適用)

Sub 巨集1()
'
' 巨集1 巨集
'

'
 
    Workbooks.Open Filename:="C:\Users\hp\Desktop\2月.xlsx" '1月己加進來,處理後面兩月就好
    Sheets("Sheet1").Select
    Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(1) '工作薄名稱己改變了,這裡也跟著改,當然在第一步時也可以先不儲存,這裡就不用改了
    Workbooks.Open Filename:="C:\Users\hp\Desktop\3月.xlsx"
    Sheets("Sheet1").Select
    Sheets(
 
"Sheet1").Move After:=Workbooks("一季度").Sheets(1)
    'ActiveWorkbook.SaveAs Filename:="C:\Users\hp\Desktop\一季度.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接儲存就好
End Sub

至此,在一季度工作薄中便有四個工作表,多出來的一個是新建工作表時的空表。但我們發現兩個問題：1.順序是倒的 2.名稱混亂。此兩問題將在下一方法中一併處理

實現方法二

對於第一個方法,只有三個檔案還好,檔案多了也很麻煩,比如1-12月合併到一年,這時我們可以使用迴圈,當然這需要我們懂一點VBA基礎(不會也沒關係,百度查查就好,前提是我們知道有"迴圈"這個概念)。當下需要處理的是檔名稱和位置,它們每次都在變化,所以,可以用變數實現。

1.檔名稱 可以用一個變數fn表示,它的原型是"C:\Users\hp\Desktop\1月.xlsx",我們首先用一個計數器i(每迴圈都會加1),現在把"1月"中的"1"分離出來就可以了,fn="C:\Users\hp\Desktop\" & 1 &"月.xlsx",然後把那個1用變數i替換,即fn = "C:\Users\hp\Desktop\" & i & "月.xlsx",這樣隨著i的改變,檔名稱也跟著變了。

2.位置 在第一個方法裡我們發現工作每次插入的位置都在第一個工作表之後,實際上應該在最後比較好,即第1次在第1個工作表之後,第2次就應該在第2個工作表之後,那很容易得知第i次應該在第i個工作表之後,親愛的讀者,你知道修改哪裡了嗎?(不知道的朋友請看程式碼)

好吧,我們把剛才插入的工作全部刪除,修改巨集1的程式碼如下,再執行試試

Sub 巨集1()
'
' 巨集1 巨集
'

'
   For i = 1 To 3
        fn = "C:\Users\hp\Desktop\" & i & "月.xlsx"
        Workbooks.Open Filename:=fn
        Sheets("Sheet1").Select
        Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(i)
    Next i
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接儲存就好
End Sub

還有一個問題:工作的名稱沒有修改,我們可以把它修改為之前工作薄的名稱,當然得去掉目錄。這個問題不會的朋友可以百度,也可以單獨錄製一個修改工作表名稱的巨集檢視程式碼,當然這裡需要分離出目錄和副檔名等,工作表名稱只需要主要部分就可以了。直接上程式碼(注意程式碼中的紅色部分)

Sub 巨集1()
'
' 巨集1 巨集
'mypath = "C:\Users\hp\Desktop\"
   For i = 1 To 3
        fn = i & "月"
        Workbooks.Open Filename:=mypath & fn & ".xlsx"
        Sheets("Sheet1").Select
        Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(i)
        Sheets(i + 1).Name = fn
    Next i
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接儲存就好
End Sub

實現方法三

如果檔名稱沒啥規律或者規律難以用變數+公式實現怎麼辦?這時,我們可以考慮用陣列——把檔名全寫入陣列,再利用前面的迴圈。這時可以需要一些新的知道——字串分割為陣列(如果不會也可以直接單個輸入)

Sub 巨集1()
'
' 巨集1 巨集
'

'
    mypath = "C:\Users\hp\Desktop\"
    Dim fn As Variant
    fn = Array("", "1月", "2月", "3月")
    Rem 以下兩行是上面兩行的另一種等效實現方式
    'Dim fn As String
    'fn = Split(",1月,2月,3月", ",")  '陣列下標一般從0開始,前面一個逗號目的是讓第一個為空,真正要用的資料便從1開始
    For i = 1 To 3
        Workbooks.Open Filename:=mypath & fn(i) & ".xlsx"
        Sheets("Sheet1").Select
        Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(i)
        Sheets(i + 1).Name = fn(i)
    Next i
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接儲存就好
End Sub