コピペで使えるVBA!複数のファイルにあるシートをコピーしてまとめるコード

VBA

VBAマクロで複数のブックにあるシートを1つのブックにまとめるコードを紹介します。

Worksheetsオブジェクトのcopyメソッドを使います。

コードをコピーすればすぐに使えます。

コピペ前提なので短さを優先してコードを書きました。

マクロを実行しているブックにまとめる

エクセルファイルのあるフォルダにマクロのファイルを保存して実行

ブック シート1 シート2 シート3 シート4 シート5
マクロ.xlsm Sheet1
ブック1.xlsx Sheet1 Sheet2
ブック2.xlsx Sheet1 Sheet2

実行後

ブック シート1 シート2 シート3 シート4 シート5
マクロ.xlsm Sheet1 ブック1_Sheet1 ブック1_Sheet2 ブック2_Sheet1 ブック2_Sheet2
ブック1.xlsx Sheet1 Sheet2
ブック2.xlsx Sheet1 Sheet2

Sub 複数のブックのシートをマクロのブックにまとめる()
    Application.ScreenUpdating = False
    Set メインブック = ActiveWorkbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each ファイル In FSO.GetFolder(ThisWorkbook.Path).Files
        If ファイル.Name = メインブック.Name Then Exit For
        If ファイル.Name Like "*.xl*" Then
            Set ターゲットブック = Workbooks.Open(ファイル.Name)
            For ターゲットシート = 1 To ターゲットブック.Worksheets.Count
                ターゲットブック.Worksheets(ターゲットシート).Copy After:=メインブック.Worksheets(メインブック.Worksheets.Count)
                メインブック.Worksheets(メインブック.Worksheets.Count).Name = Split(ターゲットブック.Name, ".")(0) & "_" & ターゲットブック.Worksheets(ターゲットシート).Name
            Next
            ターゲットブック.Close
        End If
    Next
    Set FSO = Nothing
    Application.ScreenUpdating = True
End Sub

新しいブックにまとめる

エクセルファイルのあるフォルダにマクロのファイルを保存して実行

ブック シート1 シート2 シート3 シート4 シート5
マクロ.xlsm Sheet1
ブック1.xlsx Sheet1 Sheet2
ブック2.xlsx Sheet1 Sheet2

実行後

ブック シート1 シート2 シート3 シート4 シート5
マクロ.xlsm Sheet1
ブック1.xlsx Sheet1 Sheet2
ブック2.xlsx Sheet1 Sheet2
New book! Sheet1 ブック1_Sheet1 ブック1_Sheet2 ブック2_Sheet1 ブック2_Sheet2

Sub 複数のブックのシートを新しいブックにまとめる()
    Application.ScreenUpdating = False
    Set マクロブック = ThisWorkbook
    Set メインブック = Workbooks.Add
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each ファイル In FSO.GetFolder(ThisWorkbook.Path).Files
        If ファイル.Name = マクロブック.Name Or ファイル.Name = メインブック.Name Then Exit For
        If ファイル.Name Like "*.xl*" Then
            Set ターゲットブック = Workbooks.Open(ファイル.Name)
            For ターゲットシート = 1 To ターゲットブック.Worksheets.Count
                ターゲットブック.Worksheets(ターゲットシート).Copy After:=メインブック.Worksheets(メインブック.Worksheets.Count)
                メインブック.Worksheets(メインブック.Worksheets.Count).Name = Split(ターゲットブック.Name, ".")(0) & "_" & ターゲットブック.Worksheets(ターゲットシート).Name
            Next
            ターゲットブック.Close
        End If
    Next
    Set FSO = Nothing
    Application.ScreenUpdating = True
End Sub

コメント

タイトルとURLをコピーしました