業務自動化とプログラミングのためのTips

自動化.work

Excel VBA

ディレクトリ内のエクセルのシートを1つのブックにまとめる[VBA]

更新日：

フォルダの中に存在するエクセルファイルの中のシートを1つのファイルに一瞬でまとめる方法を紹介します。

VBAマクロの流れ

今回のマクロは以下のような仕様です。

  1. 全てのシートを結合するための新しいブックを開く
  2. ユーザにブックのあるフォルダを選択を促す
  3. フォルダ内にある全てのxlsxファイルのシートを新しいシートへコピー

コードの説明

新しいワークブックの用意

新しいワークブックを開くコードは

Workbooks.Add

です。
ここで新しいワークブックの名前を取得しておきます。このブックの名前は後でシートのコピー先として指定するためです。

newWbName = ActiveWorkbook.Name

ユーザにディレクトリを選択させるダイアログを表示してパスを取得する

フォルダを選択するダイアログを表示する方法はいくつかありますが、Application.FileDialog(msoFileDialogFolderPicker)が一番簡単かと思います。
選択されたフォルダのパスを　buf = .SelectedItems(1)　で取得し、xlsxFile = Dir(buf & "\*.xlsx") で取得したディレクトリに"\*.xlsx"をくっつけてDir関数を実行しています。
*.xlsxを指定することでそのフォルダ内に存在する.xlsxファイルを全て列挙できます。

xlsxファイルの数だけループ

Do While 〜 Loop を使用してファイルの数だけ処理を行います。
Do While xlsxFile <> "" とすることでDirで取得したファイル名を1つずつ取得し、ファイル名がなくなった時点でループを終了します。

xlsxファイルを開く

Workbooks.Open buf & "\" & xlsxFile でファイルを開いています。
ここで注意が必要なのは、Dir()関数はファイルが存在した時にファイル名しか返さないため、再度ディレクトリのパスにファイル名を繋げて開くファイルのパスとして指定する必要があります。

開いたブックを不可視にする

これはあってもなくてもどちらでもいいのですが、あった方が実行した時に画面にウィンドウが出ないために見た目的に綺麗です。
ActiveWindow.Visible = False

開いたブックのシートを新しいブックにコピーする

開いたブックにあるシートの数だけ新しいブックにシートをコピーします。
シートの数だけコピーを行うため、For Each 〜 Nextを使用します。

For Each tmpSheet In Workbooks(xlsxFile).Sheets は開いたブックのシートのオブジェクトを順次tmpSheetに入れていきます。
tmpSheet.Copy After:=Workbooks(newWbName).Sheets(1) でシートを新しいブックの1枚目のシートの後にコピーします。
Next tmpSheetで開いたブックの次のシートの処理に移ります。

xlsxファイルを閉じる

コピーが終わったら開いたブックを閉じます。これをしておかないとファイルが開いたままになってしまいます。
Workbooks(xlsxFile).Close

動作確認

コードを実行するとフォルダを選択するダイアログが出ます。
テスト用にエクセルのファイルを入れたフォルダを選択します。

シートが新しく作成されたブックに全て追加されました。

今回のコード

Option Explicit

Sub JointSheets()
    Dim buf As String
    Dim xlsxFile As String
    Dim newWbName As String
    Dim tmpSheet As Object
    
'    新しいワークブックを作成、新しいWBがアクティブになる
    Workbooks.Add
    newWbName = ActiveWorkbook.Name
    
    
'    指定したディレクトリ内にあるxlsxファイルをすべて列挙
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            buf = .SelectedItems(1)
            xlsxFile = Dir(buf & "\*.xlsx")
        End If
    End With
    
'    xlsxファイルの数だけループ
    Do While xlsxFile <> ""
    
        '    xlsxファイルを開く
        Workbooks.Open buf & "\" & xlsxFile
        
        '    ブックを不可視にする
        ActiveWindow.Visible = False
        
        '    ブック内のシートの数だけループ
        For Each tmpSheet In Workbooks(xlsxFile).Sheets
            '    新しいブックに開いたブックのシートをコピーする
            tmpSheet.Copy After:=Workbooks(newWbName).Sheets(1)
        Next tmpSheet
        
        '    xlsxファイルを閉じる
        Workbooks(xlsxFile).Close
        
        '    次のxlsxファイルに移る
        xlsxFile = Dir()
    Loop
End Sub

-Excel, VBA

Copyright© 自動化.work , 2026 All Rights Reserved.