複数のエクセルファイルを結合し、指定したシートの順番に並び替えるマクロ

 複数のエクセルを結合して一つのブックにまとめる際に、シートの順番もこちらで指定したいときがあるとします。ありますよね？あるとしましょう。例えば100でも200でも良いのですが結果の図表をエクセルに出す必要があるとき、二人で各50個作って最後にまとめる時…とかです。既にあるエクセルファイルに後からシートを指定した位置に追加する時もそうです。ブックの結合もめんどくさいですし、シート順の調整なんて手でやっていたら夜どころか朝になってしまいます。

以下に記載のVBAでそれなりに結合してシート順も指定できて便利です、との自作VBA自慢の記事です。この手の記事はLLMの登場以降ニーズが少ない気もしますが…LLMに聞けば出してくれますしね。そんなことは知らん。自慢すると言っておろうが。

1シート目に実行ボタンを付けて、結合前のファイルを格納したフォルダと結合後のファイルを出力するフォルダをそれぞれhogeとpiyoに指定します。sheetSortOrderシートには結合後のシートの順番を記載しています。後は画像下にあるvbaのコードを張り付けて実行すれば結合が出来るというわけです。

罫線を入れているA列に結合後のシート順をしてください。

複数ファイルを指定すると結合+シート順の並び替えになりますが、結合前フォルダに1つのエクセルファイルだけにするとシート順の並び替えだけになります。これだけでもとても便利。以下がVBAのソースコードになります。

Sub combineMacro()

    Dim folderPath As String

    Dim filename As String

    Dim targetBook As Workbook

    Dim afterBook As Workbook

    Dim targetSheet As Worksheet

    Dim sheetSordOrder As Range

    Dim sheetName As String

    Dim sortFlag As Boolean

    Dim runTime As String

    Dim savePath As String

        

    ' 結合するExcelブックが保存されているフォルダのパスを指定

    folderPath = ThisWorkbook.Sheets("Sheet1").Range("D12").Value & "\"

    

    ' 新しいブックを作成

    Set afterBook = Workbooks.Add

    

    ' 結合マクロが保存されているブックのSheetSortOrderに記載されているシート順を取得

    Set sheetSordOrder = ThisWorkbook.Sheets("SheetSortOrder").Range("A1").CurrentRegion

    

    ' フォルダ内のExcelブックを結合

    filename = Dir(folderPath & "*.xlsx")

    Do While filename <> ""

        Set targetBook = Workbooks.Open(folderPath & filename)

        

        ' シートを結合ブックに追加

        For Each targetSheet In targetBook.Sheets

            targetSheet.Copy After:=afterBook.Sheets(afterBook.Sheets.Count)

        Next targetSheet

        

        targetBook.Close False

        filename = Dir

    Loop

    

    ' シートを並び替える

    For Each targetSheet In afterBook.Sheets

        sheetName = targetSheet.Name

        sortFlag = False

        

        ' シート名がシート順に含まれているかチェック

        For Each V_CELL In sheetSordOrder

            If V_CELL.Value = sheetName Then

                targetSheet.Move Before:=afterBook.Sheets(V_CELL.Row)

                sortFlag = True

                Exit For

            End If

        Next V_CELL

        

        ' シート名がシート順に含まれていない場合は削除

        If Not sortFlag Then

            Sheets(sheetName).Delete

        End If

    Next targetSheet

    

    ' 結合ブックを保存

    ' 実行日時を取得

    runTime = Format(Now, "yyyymmdd_hhmmss")

    

    ' 保存パスを取得

    savePath = ThisWorkbook.Sheets("Sheet1").Range("D14").Value & "\"

    afterBook.SaveAs savePath & "結合後" & runTime & ".xlsx"

    ' ブックを閉じる

    afterBook.Close   

    ' メッセージを表示

    MsgBox "結合が完了しました。"

End Sub