⚡
MergeWorkbooks
自動化選択したExcelファイルの全シートを現在のブックにコピーします
🎬 デモGIF準備中
📖 使い方
- VBAエディタを開く(Alt + F11)
- モジュールを挿入(挿入 > モジュール)
- 下記VBAコードをコピー&ペースト
- ブック上で実行(Alt + F8 でマクロ選択)
💡 実行例: MergeWorkbooks を実行し、取り込むExcelファイルを選択します
💻 VBAコード
' MergeWorkbooks
' -----------------
' Macro Name: MergeWorkbooks
' Description: 選択したExcelファイルの全シートを現在のブックにコピーします
' Parameters: なし
' Returns: なし
' Usage: MergeWorkbooks を実行し、取り込むExcelファイルを選択します
' -----------------
Sub MergeWorkbooks()
On Error GoTo ErrorHandler
Dim filePath As Variant
Dim srcWb As Workbook
Dim destWb As Workbook
Dim ws As Worksheet
Dim copiedCount As Long
Set destWb = ActiveWorkbook
filePath = Application.GetOpenFilename( _
"Excelファイル (*.xlsx;*.xlsm;*.xls), *.xlsx;*.xlsm;*.xls", , _
"取り込むExcelファイルを選択")
If filePath = False Then Exit Sub
Set srcWb = Workbooks.Open(filePath, ReadOnly:=True)
copiedCount = 0
For Each ws In srcWb.Worksheets
ws.Copy After:=destWb.Sheets(destWb.Sheets.Count)
copiedCount = copiedCount + 1
Next ws
srcWb.Close SaveChanges:=False
MsgBox copiedCount & " シートを取り込みました", vbInformation, "完了"
Exit Sub
ErrorHandler:
If Not srcWb Is Nothing Then srcWb.Close SaveChanges:=False
MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub