VBAマクロで複数のExcelファイルを自動結合する方法#0009

VBA

はじめに

毎日の業務で決まったフォルダに、出荷データや日報データなど、ファイル名や日付は違うけど、保管用ファイルとして格納しています。ある日、それらのデータを一つ一つ開き、必要なデータを集計しようと考えたことはありませんか。丁寧に手作業でやることは大事ですが、膨大な時間を消費してしまいます。そこで今回は、VBAマクロを使用し、複数のExcelファイルを一つのファイルとして自動的に結合する方法をご紹介します。このマクロを使えば、フォルダ内にある複数のExcelファイルを一括で読み込み、一つのファイルにまとめることができ、作業効率を大幅に向上させることができます。


複数ファイルを一括で自動結合

パソコンのデスクトップなど任意の場所に、「Excelファイル結合」というフォルダを作成し、そのフォルダの中に、データをまとめたいエクセルファイルを格納します。

今回の例では、「商品データ1.xlsx」、「商品データ2.xlsx」、「商品データ3.xlsx」という複数のエクセルファイルを用意し、中身は、それぞれA列に、商品コード、B列に商品名、C列に単価というような項目が統一されたものになります。

VBAマクロを実行すると、先ほど作成した「Excelファイル結合」フォルダの中に、「商品データおまとめ.xlsx」というファイルが作成され、中身は、複数のエクセルファイルを一つにしたデータが格納されます。

Sub エクセルファイルおまとめ()
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim wsDest As Worksheet
    Dim wsSource As Worksheet
    Dim FileName As String
    Dim FolderPath As String
    Dim LastRow As Long
    Dim CopyLastRow As Long
    Dim OutputFile As String
    
    ' フォルダパス(デスクトップに配置)
    FolderPath = Environ("USERPROFILE") & "\Desktop\Excelファイル結合\"
    OutputFile = FolderPath & "商品データおまとめ.xlsx"
    
    ' 既存の出力ファイルがあれば削除
    If Dir(OutputFile) <> "" Then
        Kill OutputFile
    End If
    
    ' 結合先を新しいファイルで作成
    Set wbDest = Workbooks.Add
    Set wsDest = wbDest.Sheets(1)
    wsDest.Name = "おまとめ"
    
    ' ヘッダー行をコピー
    Dim FirstFile As Boolean
    FirstFile = True
    
    ' フォルダ内の先頭ファイルを取得
    FileName = Dir(FolderPath & "*.xlsx")
    
    Do While FileName <> ""
        ' 出力ファイルは対象外
        If FileName <> "商品データおまとめ.xlsx" Then
            ' 元ファイルを開く
            Set wbSource = Workbooks.Open(FolderPath & FileName)
            Set wsSource = wbSource.Sheets(1)
            
            ' 元ファイルの最終行取得(A列)
            CopyLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
            
            ' 新しいファイルの最終行取得
            LastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
            
            If FirstFile Then
                ' ヘッダー行も含めてコピー
                wsSource.Range("A1:C" & CopyLastRow).Copy wsDest.Cells(1, 1)
                FirstFile = False
            Else
                ' 2つ目以降はデータ部分のみコピー(ヘッダー除外)
                wsSource.Range("A2:C" & CopyLastRow).Copy wsDest.Cells(LastRow + 1, 1)
            End If
            
            ' 元ファイルを保存せずに閉じる
            wbSource.Close SaveChanges:=False
        End If
        
        ' 次のファイルへ
        FileName = Dir
    Loop
    
    ' 新しいファイルを保存して閉じる
    Application.DisplayAlerts = False
    wbDest.SaveAs OutputFile, FileFormat:=xlOpenXMLWorkbook
    wbDest.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    MsgBox "ファイルの結合が完了しました。" & vbCrLf & OutputFile
End Sub

コードの解説:

FolderPath = Environ("USERPROFILE") & "\Desktop\Excelファイル結合\"
OutputFile = FolderPath & "商品データおまとめ.xlsx"

デスクトップに作成済の「Excelファイル結合」の中に元ファイルを格納することで動作します。データ結合後は、商品データおまとめ.xlsxとして書き出します。

' 既存の出力ファイルがあれば削除
    If Dir(OutputFile) <> "" Then
        Kill OutputFile
    End If

使いまわしのVBAマクロで作成しましたので、もし、既に商品データおまとめ.xlsxがある場合は、削除をします。

 ' フォルダ内の先頭ファイルを取得
    FileName = Dir(FolderPath & "*.xlsx")
    
    Do While FileName <> ""

Excelファイル結合フォルダに、結合したい元データとなる、ファイルを入れます。拡張子は、xlsxのみです。Excelファイル結合フォルダの上から順にファイルを処理されます。結合に不要なファイルを入れないように注意して下さい。

' 結合先を新しいファイルで作成
    Set wbDest = Workbooks.Add
    Set wsDest = wbDest.Sheets(1)
    wsDest.Name = "おまとめ"

結合データは、新しいエクセルファイルとして保存します。※商品データおまとめ.xlsxという名前になります。シート名は、「おまとめ」です。

If FirstFile Then
 ' ヘッダー行も含めてコピー
    wsSource.Range("A1:C" & CopyLastRow).Copy wsDest.Cells(1, 1)
    FirstFile = False
        Else
' 2つ目以降はデータ部分のみコピー(ヘッダー除外)
     wsSource.Range("A2:C" & CopyLastRow).Copy wsDest.Cells(LastRow + 1, 1)
        End If

1行目は、ヘッダー行です。2行目以降はデータ行になります。

 ' 元ファイルを保存せずに閉じる
            wbSource.Close SaveChanges:=False

使用した元データは、何もせずに閉じます。

' 新しいファイルを保存して閉じる
    Application.DisplayAlerts = False
    wbDest.SaveAs OutputFile, FileFormat:=xlOpenXMLWorkbook
    wbDest.Close SaveChanges:=False
    Application.DisplayAlerts = True

新しいファイルを保存します。※ファイル名は、商品データおまとめ.xlsxです。格納先は、「Excelファイル結合」です。

MsgBox "ファイルの結合が完了しました。" & vbCrLf & OutputFile

VBAマクロが正常に完了した場合は、ポップアップでお知らせをします。

エクセルで、任意で結合ファイルを設定する方法

今度は、結合したいファイルを指定したい場合や、この順番で結合したいというような、任意オプションを加えてみます。その際に、エクセルで指定する方法をご紹介します。

事前準備-VBAマクロを実行する前に

デスクトップ上に「Excelファイル結合」というフォルダを作成する。

以下のVBAマクロを実行するエクセルマクロファイルのF2セル~F13セルに写真と同じように項目名を記載する。※最初は同じようにやるのをオススメしますが、任意名でもOK。

G列に必要情報を入力します。G2セルには、作成した「Excelファイル結合」フォルダのある、アドレスを入力します。

G3セルには、VBAマクロ実行後に結合ファイルを保存しますが、そのファイル名を記載します。

G4セル~G13セルまでは、データの結合を行いたいファイル名、拡張子を含む形を入力します。

Sub エクセルファイルおまとめ()
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim wsDest As Worksheet
    Dim wsSource As Worksheet
    Dim FolderPath As String
    Dim OutputFile As String
    Dim LastRow As Long, CopyLastRow As Long
    Dim i As Long
    Dim SkipFiles As String
    
    ' ========= 設定値をシートから取得 =========
    FolderPath = Trim(Range("G2").Value)
    If Right(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
    End If
    
    OutputFile = FolderPath & Trim(Range("G3").Value)
    
    Dim SourceFiles(1 To 10) As String
    For i = 1 To 10
        SourceFiles(i) = Trim(Range("G" & (3 + i)).Value)
    Next i
    ' =======================================
    
    ' 出力先フォルダが存在しない場合は作成
    If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
    End If
    
    ' 既存ファイル削除
    If Dir(OutputFile) <> "" Then Kill OutputFile
    
    ' 新しいファイルを作成
    Set wbDest = Workbooks.Add
    Set wsDest = wbDest.Sheets(1)
    
    Dim FirstFile As Boolean: FirstFile = True
    
    ' 元データ1~元データ10までのファイルを順番に処理
    For i = 1 To 10
        If SourceFiles(i) <> "" Then
            ' ファイル存在チェック
            If Dir(FolderPath & SourceFiles(i)) <> "" Then
                ' ファイルを開く
                Set wbSource = Workbooks.Open(FolderPath & SourceFiles(i))
                
                ' シート数チェック
                If wbSource.Sheets.Count = 1 Then
                    Set wsSource = wbSource.Sheets(1)
                    
                    CopyLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
                    LastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
                    
                    If FirstFile Then
                        wsSource.Range("A1:C" & CopyLastRow).Copy wsDest.Cells(1, 1)
                        FirstFile = False
                    Else
                        wsSource.Range("A2:C" & CopyLastRow).Copy wsDest.Cells(LastRow + 1, 1)
                    End If
                Else
                    ' 複数シートあり → スキップ
                    SkipFiles = SkipFiles & vbCrLf & _
                        "元データ" & i & ":" & SourceFiles(i) & " → 複数シートあり"
                End If
                
                ' 元ファイルを保存せず閉じる
                wbSource.Close SaveChanges:=False
            Else
                ' ファイルが存在しない場合
                SkipFiles = SkipFiles & vbCrLf & _
                    "元データ" & i & ":" & SourceFiles(i) & " → ファイル名相違"
            End If
        End If
    Next i
    
    ' 保存
    Application.DisplayAlerts = False
    wbDest.SaveAs FileName:=OutputFile, FileFormat:=xlOpenXMLWorkbook
    wbDest.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    ' メッセージ
    If SkipFiles = "" Then
        MsgBox "結合が完了しました。: " & vbCrLf & OutputFile, vbInformation
    Else
        MsgBox "結合が完了しました。: " & vbCrLf & OutputFile & vbCrLf & vbCrLf & _
               "次のファイルはスキップしました:" & vbCrLf & SkipFiles, vbExclamation
    End If
End Sub

コードの解説:

' ========= 設定値をシートから取得 =========
    FolderPath = Trim(Range("G2").Value)
    If Right(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
    End If
    
    OutputFile = FolderPath & Trim(Range("G3").Value)
    
    Dim SourceFiles(1 To 10) As String
    For i = 1 To 10
        SourceFiles(i) = Trim(Range("G" & (3 + i)).Value)
    Next i
    ' =======================================

エクセルのF列G列の設定を取得します。フォルダパスや、出力ファイル名、元データの名前など

' 出力先フォルダが存在しない場合は作成
    If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
    End If

' 既存ファイル削除
    If Dir(OutputFile) <> "" Then Kill OutputFile

' 新しいファイルを作成
    Set wbDest = Workbooks.Add
    Set wsDest = wbDest.Sheets(1)

VBAマクロを実行する前に作成するフォルダが見つからない場合は、作成します。作成場所はG2セルのフォルダパスに入力した場所です。

最後、結合ファイルを上記のフォルダに保存をしますが、G3セルの保存ファイル名が既にある場合は削除を行います。

また、出力するファイルは、新しくエクセルを立ち上げそこに記載します。

 ' 元データ1~元データ10までのファイルを順番に処理
    For i = 1 To 10
        If SourceFiles(i) <> "" Then
            ' ファイル存在チェック
            If Dir(FolderPath & SourceFiles(i)) <> "" Then
                ' ファイルを開く
                Set wbSource = Workbooks.Open(FolderPath & SourceFiles(i))
                
                ' シート数チェック
                If wbSource.Sheets.Count = 1 Then
                    Set wsSource = wbSource.Sheets(1)
                    
                    CopyLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
                    LastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
                    
                    If FirstFile Then
                        wsSource.Range("A1:C" & CopyLastRow).Copy wsDest.Cells(1, 1)
                        FirstFile = False
                    Else
                        wsSource.Range("A2:C" & CopyLastRow).Copy wsDest.Cells(LastRow + 1, 1)
                    End If
                Else
                    ' 複数シートあり → スキップ
                    SkipFiles = SkipFiles & vbCrLf & _
                        "元データ" & i & ":" & SourceFiles(i) & " → 複数シートあり"
                End If
                
                ' 元ファイルを保存せず閉じる
                wbSource.Close SaveChanges:=False
            Else
                ' ファイルが存在しない場合
                SkipFiles = SkipFiles & vbCrLf & _
                    "元データ" & i & ":" & SourceFiles(i) & " → ファイル名相違"
            End If
        End If
    Next i

G4セルからG13セルに設定した、元データのファイル名を順番にデータの結合をします。

もし入力したファイルがない場合は、何もせず、スキップです。

また、元データファイルのシートは必ず1シートだけにして下さい。もし複数シートがある場合も何もせずスキップします。

※スキップとなったファイルは、VBAマクロの実行終了前にウィンドウメッセージとして、表示します。

ファイルがない場合→ファイル名相違

複数シートがあった場合→複数シートあり

というようなメッセージを促します。

' 保存
    Application.DisplayAlerts = False
    wbDest.SaveAs FileName:=OutputFile, FileFormat:=xlOpenXMLWorkbook
    wbDest.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    ' メッセージ
    If SkipFiles = "" Then
        MsgBox "結合が完了しました。: " & vbCrLf & OutputFile, vbInformation
    Else
        MsgBox "結合が完了しました。: " & vbCrLf & OutputFile & vbCrLf & vbCrLf & _
               "次のファイルはスキップしました:" & vbCrLf & SkipFiles, vbExclamation
    End If

元データは、保存せずに閉じます。また結合した新規ファイルは、ファイルパスと同じ場所に保存します。

正常に完了した場合は、結合が完了しました。というメッセージを。

正常に完了できなかった場合は、結合が完了しました。次のファイルはスキップしました。詳しい詳細をメッセージとして表示します。

どちらも、結合まで行います。万一スキップが発生した場合は、元データのシートを1枚にする。やG列に入力した内容を修正し、再度、VBAマクロを実行します。

まとめ

今回の投稿記事では、フォルダに格納した元データを自動的に結合するVBAマクロを紹介しました。そのままご使用しても良いですし、元データを格納するフォルダパスや、シート名を変更したい。そのような場合には、VBAコードを一部修正する。まだ、VBAコードは不慣れですというような方の場合は、後半部分のエクセルで、任意で結合ファイルを設定する方法、をご参考にしていただき、任意のフォルダやファイルをエクセルセルで設定することで、視覚的にわかりやすく、かんたんに複数のエクセルファイルを一つのエクセルファイルにデータ結合することが出来ます。    

コメント

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