指定したフォルダ内にあるExcelファイルを一つにまとめるVBAマクロ

ホーム
Excel, Office関連
指定したフォルダ内にあるExcelファイルを一つにまとめるVBAマクロ

2018.02.9

指定したフォルダ内にあるExcelファイルを一つにまとめるVBAマクロ

複数あるファイルを一つにまとめるにはどうすれば良いか？という質問をいただいたので、簡単なマクロを書いてみました。
下記の通り、それぞれの処理の意味はコメントで記入してあります。

Option Explicit

Public Sub Sample()
  Dim bkWork As Workbook '作業用ワークブック
  Dim bkSrc As Workbook 'コピー元ワークブック
  Dim shtIni As Worksheet '初期ワークシート
  Dim folderPath As String '処理対象のフォルダパス
  Dim tmpSinw As Long 'SheetsInNewWorkbook一次記憶用
  Dim tmpDa As Boolean 'DisplayAlerts一次記憶用
  Dim itm As Object
  
  'Excelファイルが保存されているフォルダを選択
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False '複数選択しない
    .Title = "Excelファイルが保存されているフォルダを選択"
    If .Show = True Then
      folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
      Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If
  End With
  
  '作業用ワークブックの作成
  With Application
    tmpSinw = .SheetsInNewWorkbook '新規ワークブックに自動的に挿入されるシート数を記憶
    .SheetsInNewWorkbook = 1
    Set bkWork = .Workbooks.Add 'ワークブック追加
    Set shtIni = bkWork.Sheets(1) '最初の空白ワークシートを記憶
    .SheetsInNewWorkbook = tmpSinw '新規ワークブックに自動的に挿入されるシート数を元に戻す
  End With
  
  'ファイルの処理にFileSystemObjectオブジェクトを利用
  With CreateObject("Scripting.FileSystemObject")
    '指定したフォルダ内のファイルを順番に処理
    For Each itm In .GetFolder(folderPath).Files
      '処理対象となるファイルの拡張子を指定
      Select Case LCase(.GetExtensionName(itm.Path))
        Case "xls", "xlsx", "xlsm", "csv"
          Set bkSrc = Application.Workbooks.Open(itm.Path) 'コピー元のワークブックを開く
          With bkWork
            '全シートを作業用ワークブックにコピー
            '※同名のワークシートがある場合は自動的にシート名が変更される
            bkSrc.Sheets.Copy After:=.Sheets(.Sheets.Count)
          End With
          bkSrc.Close SaveChanges:=False 'コピー元のワークブックを変更せずに閉じる
      End Select
    Next
  End With
  
  '最初の空白ワークシートを削除
  If bkWork.Sheets.Count > 1 Then
    With Application
      tmpDa = .DisplayAlerts '警告の表示状態を記憶
      .DisplayAlerts = False '警告の表示を無効に設定
      shtIni.Delete 'ワークシート削除
      .DisplayAlerts = tmpDa '警告の表示状態を元に戻す
    End With
  End If
End Sub

コードの貼り付け方や実行方法が分からない場合は、下記のような入門者向けのサイトをご参照ください。