【エクセルVBA】複数のエクセルを一括でまとめるVBA

あのー、複数のエクセルファイルを一括で１ファイルにまとめる方法ってありますか。

あー、標準機能では用意されていませんね。

そうですよねー。めんどうだなー。

マクロで解決する方法があるみたいですよ、ご紹介しましょう！

複数のエクセルファイルを一括で１ファイルにまとめるマクロをご紹介します。

マクロ機能が有効なExcelブック「.xlsm」を作成

Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方

作成したマクロファイルに名前を設定して保存します。
※ここでは「同じフォルダにある複数のエクセルを一括でまとめるVBA.xlsm」と設定します。

コードを標準モジュールに貼り付け

標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方

標準モジュールを開いて、下記のコードを貼り付けて下さい。

コード

Option Explicit
'#############################################################################
' Main
'#############################################################################
Sub Main()

    MsgBox "まとめたいエクセルブックのフォルダを選択して、" & vbCrLf & _
           "「OK」をクリックして下さい。"
    
    '画面表示OFF
    Application.ScreenUpdating = False
 
    '-------------------------------------------
    ' 変数定義
    '-------------------------------------------
    Const cnsDIR = "\*.xls*"                '対象フォルダ内エクセルファイル検索用
    Dim FilePath As String                  'ファイルパス
    Dim strFileName As String               '結合元ファイル名
     
    Dim i As Integer                        'ループ用
     
    'シート結合エクセル用オブジェクト
    Dim App As Excel.Application
    Dim Book As Workbook
    Dim Sheet As Worksheet
    'シート結合エクセル保存名
    Dim BookName As String
     
    '結合元エクセル用
    Dim Book2 As Workbook
    Dim Sheet2 As Worksheet
     
    '-------------------------------------------
    ' シート結合後のファイル名の指定
    '-------------------------------------------
    BookName = Format(Now(), "yyyymmdd-hhmmss") & "【まとめファイル】.xlsx"
     
    '-------------------------------------------
    ' 結合元のフォルダ選択
    '-------------------------------------------
    FilePath = FolderSelect()
     
    'キャンセル時
    If FilePath = "" Then
        MsgBox "キャンセルされました。処理を終了します。"
        End
    End If
     
    '-------------------------------------------
    ' 結合先ワークブック作成
    '-------------------------------------------
    'オブジェクトセット
    Set App = CreateObject("Excel.Application")
    '非表示
    App.Visible = False
    'エクセル新規オープン
    Set Book = App.Workbooks.Add
     
    '-------------------------------------------
    ' 結合先ワークブックにコピー
    '-------------------------------------------
    ' 先頭のファイル名の取得
    strFileName = Dir(FilePath & cnsDIR, vbNormal)
     
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFileName <> ""
     
        '対象フォルダ配下のエクセルオープン
        Set Book2 = App.Workbooks.Open(Filename:=FilePath & "\" & strFileName)
        
        '開いたコピー元のエクセルのシート分繰り返す
        For i = 1 To Book2.Worksheets.Count
        
            Book2.Worksheets(i).Visible = True
        
            '結合用のブックにシートコピー
            Book2.Worksheets(i).Copy after:=Book.Worksheets(i)
            'シート名を「元のエクセル名.元のシート名」に変更
            Book.ActiveSheet.Name = Book2.Name & "." & Book2.Worksheets(i).Name
            
            'エラー時処理
            On Error GoTo Err1
         
        Next i
         
        'コピー元のエクセルを保存せずに閉じる
        Book2.Close (False)
        ' 次のファイル名を取得
        strFileName = Dir()
         
    Loop
     
    '-------------------------------------------
    ' 結合したエクセルの終了
    '-------------------------------------------
    'シート「Sheet1」を削除
    Book.Worksheets("Sheet1").Delete
    '名前を付けて保存
    Book.SaveAs Filename:=FilePath & "\" & BookName
    'エクセルを閉じる
    Book.Close (False)
 
    '-------------------------------------------
    ' 終了処理
    '-------------------------------------------
    Set Sheet2 = Nothing
    Set Book2 = Nothing
 
    Set Sheet = Nothing
    Set Book = Nothing
    Set App = Nothing
    
    MsgBox "処理を完了します。"
 
    '画面表示ON
    Application.ScreenUpdating = True
    End
   
'エラー時処理
Err1:
    Application.DisplayAlerts = False
    MsgBox "シート名が正しくありません。" & vbCrLf & _
"下記がエラー理由と思われます。" & vbCrLf & vbCrLf & _
"◆想定されるエラー理由" & vbCrLf & _
"・結合元ブック名+拡張子+シート名が32文字以上なっている。" & vbCrLf & _
"・結合元ブック名に、シート名に設定出来ない文字が含まれている。" & vbCrLf & _
":、\、/、?、*、[、]、" & vbCrLf & vbCrLf & _
"結合元ブック名、シート名の修正後、マクロを実行してください。" & vbCrLf & vbCrLf & _
"処理を終了します。", Title:="エラー"

    '画面表示ON
    Application.DisplayAlerts = True
    End
 
End Sub
 
'#############################################################################
' フォルダ参照用
'#############################################################################
Function FolderSelect() As String
 
    '-------------------------------------------
    ' 変数定義
    '-------------------------------------------
    Dim objFileDialog As Object             'FileDialog
    Dim strTitle As String                  'タイトル
    Dim strPath As String                   'フォルダパス
    Dim strInitialPath As String            '初期フォルダパス
     
    '-------------------------------------------
    ' フォルダ選択ダイアログの初期設定
    '-------------------------------------------
    'ダイアログタイトル
    strTitle = "結合元のフォルダを選択してください"
    'ダイアログの初期パスをモジュール起動エクセルに設定
    strInitialPath = ActiveWorkbook.Path
     
    '-------------------------------------------
    ' フォルダ選択ダイアログ表示
    '-------------------------------------------
    Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         
    With objFileDialog
        'タイトル
        .Title = strTitle
        '初期フォルダパス
        .InitialFileName = strInitialPath
         
        If .Show = False Then
            'キャンセル時
            GoTo Exit_Function
        Else
            'フォルダパス取得
            strPath = .SelectedItems(1)
        End If
     
    End With
     
    '-------------------------------------------
    ' 終了処理
    '-------------------------------------------
Exit_Function:
    Set objFileDialog = Nothing
     
    FolderSelect = strPath
 
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

Option Explicit

'#############################################################################

' Main

'#############################################################################

Sub Main()

MsgBox "まとめたいエクセルブックのフォルダを選択して、" & vbCrLf & _

"「OK」をクリックして下さい。"

'画面表示OFF

Application.ScreenUpdating = False

'-------------------------------------------

' 変数定義

'-------------------------------------------

Const cnsDIR = "\*.xls*" '対象フォルダ内エクセルファイル検索用

Dim FilePath As String 'ファイルパス

Dim strFileName As String '結合元ファイル名

Dim i As Integer 'ループ用

'シート結合エクセル用オブジェクト

Dim App As Excel.Application

Dim Book As Workbook

Dim Sheet As Worksheet

'シート結合エクセル保存名

Dim BookName As String

'結合元エクセル用

Dim Book2 As Workbook

Dim Sheet2 As Worksheet

'-------------------------------------------

' シート結合後のファイル名の指定

'-------------------------------------------

BookName = Format(Now(), "yyyymmdd-hhmmss") & "【まとめファイル】.xlsx"

'-------------------------------------------

' 結合元のフォルダ選択

'-------------------------------------------

FilePath = FolderSelect()

'キャンセル時

If FilePath = "" Then

MsgBox "キャンセルされました。処理を終了します。"

End

End If

'-------------------------------------------

' 結合先ワークブック作成

'-------------------------------------------

'オブジェクトセット

Set App = CreateObject("Excel.Application")

'非表示

App.Visible = False

'エクセル新規オープン

Set Book = App.Workbooks.Add

'-------------------------------------------

' 結合先ワークブックにコピー

'-------------------------------------------

' 先頭のファイル名の取得

strFileName = Dir(FilePath & cnsDIR, vbNormal)

' ファイルが見つからなくなるまで繰り返す

Do While strFileName <> ""

'対象フォルダ配下のエクセルオープン

Set Book2 = App.Workbooks.Open(Filename:=FilePath & "\" & strFileName)

'開いたコピー元のエクセルのシート分繰り返す

For i = 1 To Book2.Worksheets.Count

Book2.Worksheets(i).Visible = True

'結合用のブックにシートコピー

Book2.Worksheets(i).Copy after:=Book.Worksheets(i)

'シート名を「元のエクセル名.元のシート名」に変更

Book.ActiveSheet.Name = Book2.Name & "." & Book2.Worksheets(i).Name

'エラー時処理

On Error GoTo Err1

Next i

'コピー元のエクセルを保存せずに閉じる

Book2.Close (False)

' 次のファイル名を取得

strFileName = Dir()

Loop

'-------------------------------------------

' 結合したエクセルの終了

'-------------------------------------------

'シート「Sheet1」を削除

Book.Worksheets("Sheet1").Delete

'名前を付けて保存

Book.SaveAs Filename:=FilePath & "\" & BookName

'エクセルを閉じる

Book.Close (False)

'-------------------------------------------

' 終了処理

'-------------------------------------------

Set Sheet2 = Nothing

Set Book2 = Nothing

Set Sheet = Nothing

Set Book = Nothing

Set App = Nothing

MsgBox "処理を完了します。"

'画面表示ON

Application.ScreenUpdating = True

End

'エラー時処理

Err1:

Application.DisplayAlerts = False

MsgBox "シート名が正しくありません。" & vbCrLf & _

"下記がエラー理由と思われます。" & vbCrLf & vbCrLf & _

"◆想定されるエラー理由" & vbCrLf & _

"・結合元ブック名+拡張子+シート名が32文字以上なっている。" & vbCrLf & _

"・結合元ブック名に、シート名に設定出来ない文字が含まれている。" & vbCrLf & _

":、\、/、?、*、[、]、" & vbCrLf & vbCrLf & _

"結合元ブック名、シート名の修正後、マクロを実行してください。" & vbCrLf & vbCrLf & _

"処理を終了します。", Title:="エラー"

'画面表示ON

Application.DisplayAlerts = True

End

End Sub

'#############################################################################

' フォルダ参照用

'#############################################################################

Function FolderSelect() As String

'-------------------------------------------

' 変数定義

'-------------------------------------------

Dim objFileDialog As Object 'FileDialog

Dim strTitle As String 'タイトル

Dim strPath As String 'フォルダパス

Dim strInitialPath As String '初期フォルダパス

'-------------------------------------------

' フォルダ選択ダイアログの初期設定

'-------------------------------------------

'ダイアログタイトル

strTitle = "結合元のフォルダを選択してください"

'ダイアログの初期パスをモジュール起動エクセルに設定

strInitialPath = ActiveWorkbook.Path

'-------------------------------------------

' フォルダ選択ダイアログ表示

'-------------------------------------------

Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

With objFileDialog

'タイトル

.Title = strTitle

'初期フォルダパス

.InitialFileName = strInitialPath

If .Show = False Then

'キャンセル時

GoTo Exit_Function

Else

'フォルダパス取得

strPath = .SelectedItems(1)

End If

End With

'-------------------------------------------

' 終了処理

'-------------------------------------------

Exit_Function:

Set objFileDialog = Nothing

FolderSelect = strPath

End Function

ダミーデータを準備する

マクロ実行テスト用のダミーデータとして、エクセルファイルを準備します。
※フォルダ名は任意です。例として「エクセルをまとめるテストフォルダ」と入力します。

マクロを実行する

マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない（クリック不要の）場合もあります。

「開発」タブをクリックします。

「マクロ」をクリックします。

マクロ「Main」を選択、「実行」をクリックします。

「OK」をクリックします。

まとめたいエクセルファイルが格納されているフォルダを選択→「OK」をクリックします。

「OK」をクリックします。

まとめるエクセルファイルと同じフォルダに「yyyymmdd-hhmmss【まとめファイル】.xlsx」が作成されます。

「yyyymmdd-hhmmss【まとめファイル】.xlsx」を開くと、対象のエクセルのシートがコピーされています。

完了です。

注意点

ファイル名＋拡張子＋シート名の文字数を31文字以内にする

本VBAでまとめる「ファイル名＋拡張子＋シート名」の文字数は、
合計で31文字以内にしてください。

「yyyymmdd-hhmmss【まとめファイル】.xlsx」のシート名は、
「ファイル名＋拡張子＋シート名」で作成されます。

エクセルの仕様上、シート名は31文字以内の為、
「ファイル名＋拡張子＋シート名」の文字数が、
合計で32文字以上になるとエラーになります。

※ファイル名・シート名を一括置換するエクセルVBAは下記記事を参考にしてください。
ファイル名を一括取得するVBAと一括置換するVBA

【エクセルVBA】ファイル名を一括取得するVBAと一括置換するVBA

エクセルのシート名を一括取得するVBA

エクセルのシート名を一括取得するVBA

エクセルのシート名を一括置換するVBA

エクセルのシート名を一括置換するVBA

その他

※本VBA機能を含む、VBAマクロツールを作成しました。
下記の記事からダウンロードしてお試し下さい。
【累計1,100ダウンロード突破！！】汎用エクセルVBAツール【HUNT】

マクロ実行動画

参考元情報・リンク

IT Diary
【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA