VBA腳本分享:一鍵批次複製Excel分頁到多個檔案的實用教學
因為筆者在工作上遇到,需要複製一個分頁到其他excel中,也因為要複製的excel很多所以才決定使用vba節省時間,為了怕之後忘記寫下來紀錄。
使用情境:一個資料夾中有多個excel需要更換同一分頁資料。
程式說明:
Sub 複製()
'
' 巨集4 巨集
Dim FileName As String, sht As Worksheet, wb As Workbook
Dim Erow As Long, fn As String, arr As Variant
FileName = Dir(ThisWorkbook.Path & "\\*.xlsm")'找出資料夾中所有副檔名為.xlsm之檔案
Do While FileName <> ""
If FileName <> ThisWorkbook.name Then '判斷檔案是否為本資料的活頁簿
copy FileName'執行下面的copy函式,並帶入FileName
Windows(FileName).Close savechanges:=True'將複製完之檔案儲存並關閉
End If
FileName = Dir()
Loop
'
End Sub
'複製分頁
Sub copy(FileName)
Dim src As Workbook
'依照帶入的FileName開啟檔案
Set src = Workbooks.Open(ThisWorkbook.Path & "\\" & FileName)
Windows(FileName).Activate
Dim test As Workbook
Dim target As Workbook
Dim or_sheet As Worksheet
Dim tar_sheet As Worksheet
Dim tar_sheet_range As Range
' 打開源工作簿
'Set test = Workbooks.Open("test.xlsx")
' 打開目標工作簿
'Set target = Workbooks.Open("target.xlsx")
' 指定源分頁
Set or_sheet = ThisWorkbook.Sheets("來源分頁名稱")'請修改成指定之檔案名稱
' 指定目標分頁
Set tar_sheet = src.Sheets("目標分頁名稱")'請修改成指定之檔案名稱
'指定複製的範圍
Set tar_sheet_range = or_sheet.Range("A1:B47")'請修改成所需之範圍
' 清空目標分頁的內容
'tar_sheet.Cells.Clear
' 複製源分頁的內容到目標分頁
'or_sheet.UsedRange.copy tar_sheet.Range("B4")'複製整分頁
' 複製範圍內容到目標分頁
tar_sheet_range.copy tar_sheet.Range("A1")
' 關閉工作簿,不保存更改
'test.Close False
'src.Save
'src.Close
End Sub
使用步驟
前情提要:
在同一個資料夾內有4個檔案,檔案名稱分別為V1.xlsm、V2.xlsm、V3.xlsm以及test.xlsm
執行巨集的檔案名稱為”test.xlsm”,目標要將”test.xlsm”中的分頁”待複製資料”,貼到V1.xlsm、V2.xlsm以及V3.xlsm的”工作表1”分頁
步驟1.建立巨集並將上述程式碼貼入巨集中
如果不知道如何建立巨集的請參考筆者之前寫的文章(輕鬆取得資料夾內所有檔案名稱的VBA程式 – 提升你的工作效率!)。
建立完巨集後,將上述的程式碼複製貼到所建立的巨集中
步驟2.修改程式碼修改分頁名稱及複製範圍
如下圖所示將上述程式碼中”來源分頁名稱”以及”目標分頁名稱”分別修改為”待複製資料”以及”工作表1”。
再確定複製範圍是否為所需範圍,如下圖資料範圍為A1到P19
將上述數據範圍修改為所需資料範圍A1到P19
步驟4.執行
如下圖所示執行巨集名稱”複製”。
此處之巨集名稱之所以與當初建立的不同是因為,再貼上程式碼時筆者將原本預設的程式碼完全刪除後再貼上本文的程式碼,而巨集之名稱與sub 後面的文字名稱有關,因此才會看到巨集名稱改為”複製”。
步驟5.複製完成
參考
[1]https://www.statology.org/vba-copy-range-to-another-sheet/
[2]https://www.automateexcel.com/vba/copy-worksheet/
[3]https://www.ablebits.com/office-addins-blog/duplicate-sheet-excel-vba/