【Excel VBA】複数ファイルを1ファイルにまとめるマクロを作成する

当ページのリンクには広告が含まれている可能性があります。
複数ファイルを1ファイルにまとめる

こんにちは、ユーキです。

複数ファイルを1つのファイルにまとめるマクロを紹介します。

目次

仕様

今回、作成する機能は以下になります。

作成する機能
  • 読み込むフォルダは1か所を指定する
  • 読み込みフォルダ内の対象ファイルは複数存在する
  • 読み込み対象ファイルの拡張子は「.xlsx」のみとする
  • 読み込んだ結果を出力先は新規ファイルとし、保存は行わない

複数ファイルを1ファイルにまとめるマクロの作成

それでは早速、複数ファイルを1ファイルにまとめるマクロを作成を作成していきましょう。

ファイルの一覧を作成する

まずはファイルの一覧を作成する機能を作成します。

作成するのは、以下の機能です。

  • 指定フォルダからファイルの一覧を読み込む
  • 読み込むファイルは「.xlsx」だけにする
  • 対象フォルダを指定できるようにする
  • 実行ボタンを追加する

指定フォルダからファイルの一覧を読み込む

指定パスからファイルの一覧を作成する処理を書きます。

ファイルの一覧取得は下記の記事を参考にします。

Public Sub FileList()
    Dim rowIdx As Long
    Dim path As String
    Dim fs As Object
    Dim f As Object
    path = "C:\Temp"
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    '先頭行を設定。10行目からスターとするようにします。
    rowIdx = 10
    For Each f In fs.GetFolder(path).Files
        ActiveSheet.Cells(rowIdx, 2).Value = f.path 'B列にフルパスを表示
        rowIdx = rowIdx + 1
    Next f    
End Sub

この処理はボタン押下時イベントから呼び出しをするため、標準モジュールに記載をします。

読み込むファイルは「.xlsx」だけにする

指定フォルダ内のファイルに画像ファイルなどがある場合も考慮をして、拡張子が「.xlsx」のファイルだけが対象となるようにします。

拡張子の取得は、Scripting.FileSystemObjectのGetExtensionNameメソッドを使用します。

        If fs.GetExtensionName(f.path) = "xlsx" Then
        
        End If

対象フォルダを指定できるようにする

読み込み対象のフォルダを指定できないと使い勝手が悪いので、パスを指定できるようにします。

パスの入力は、C2セルから値を読み込むようにします。

       path = ActiveSheet.Cells(2, 3).Value

FileList関数の全体は次のようになります。

Public Sub FileList()

    Dim rowIdx As Long
    Dim path As String
    Dim fs As Object
    Dim f As Object
    
    path = ActiveSheet.Cells(2, 3).Value
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    '先頭行を設定。10行目からスターとするようにします。
    rowIdx = 10
    
    For Each f In fs.GetFolder(path).Files
        If fs.GetExtensionName(f.path) = "xlsx" Then
            ActiveSheet.Cells(rowIdx, 2).Value = f.path 'B列にフルパスを表示
            rowIdx = rowIdx + 1
        End If
    Next f
    
End Sub

実行ボタンを追加する

ファイルの一覧が取得できるようになったので、実行ボタンを追加しておきましょう。

ボタンの追加方法は以下の記事を参考にします。

ボタンの名前は「btnExec」としました。

先ほど作成したファイルの一覧取得処理をボタン押下時に呼び出すようにします。

Private Sub btnExec_Click()
    Call FileList
End Sub

これでボタン押下すると、指定したフォルダのファイル一覧が取得できるようになります。

1ファイルにまとめる

ファイルの一覧が作成できるようになったので、ここからは1ファイルにまとめる処理を書いていきます。

作成する機能は、以下になります。

  • 新規ブックを作成する
  • ファイル一覧のファイルを1つずつ処理する(ループ処理)
  • 対象ファイルを読み取り専用で開く
  • ファイルを読み取る
  • 読み取った内容をまとめファイルへ転記する
  • 関数として処理をまとめる

新規ブックを作成する

まずは1つにまとめるブックを新規で作成します。新規ブックは「Workbooks.Add」で作成が可能です。
このブックはあとで使うので、変数に設定しておきます。

    Dim newWb As Workbook
    Set newWb = Workbooks.Add

ファイル一覧のファイルを1つずつ処理する(ループ処理)

作成したファイル一覧からファイルを1ファイルずつ開いて読み込んでいきます。

繰り返し(ループ)処理を使って実装をします。対象ファイルが何件になるかがわからないので、読み込むファイルがなくなった時点で終了です。

while文でファイル名が空白になったところで処理を終了するように実装します。

while文の使い方は以下の記事を参考にしてください。

    Dim fileCnt As Integer
    fileCnt = 0
    While ActiveSheet.Cells(10 + fileCnt, 2).Value <> ""
    
        fileCnt = fileCnt + 1
    Wend

対象ファイルを読み取り専用で開く

では、対象ファイルを開きましょう。ファイルの更新が不要なので、ファイルは読み取り専用で開くことにします。

    Dim readWb As Workbook
    'ファイルを読み取り専用で開く
    Set readWb = Workbooks.Open(ActiveSheet.Cells(10 + fileCnt, 2).Value, ReadOnly:=True)

ファイルを読み取る

開いたファイルを読みこんで、コピーする処理を書きます。コピー対象は最初のシートのみとします。

シートの対象範囲はUsedRangeプロパティを使って指定します。対象するシートは1シートのみとします。
複数シートがある場合、選択→コピー→貼り付けを繰り返しましょう。

        readWb.Sheets(1).UsedRange.Select
        readWb.Sheets(1).UsedRange.Copy

読み取った内容をまとめファイルへ転記する

読み取った内容をまとめファイルへ貼り付けます。

引数Destinationには、貼り付け位置を指定します。複数ファイルを読み込むので、読み込んだ行数を追加していく必要があるため、変数にします。貼り付けが完了したら張り付けた行数を加算します。

ファイルを閉じる際に「クリップボードに大きな値があります」というダイアログを出さないように、CutCopyModeをFalseに設定します。

        newWb.Sheets(1).Paste Destination:=newWb.Sheets(1).Range("A" & rowIdx)
        readWb.Application.CutCopyMode = False
        rowIdx = rowIdx + readWb.Sheets(1).UsedRange.Rows.Count

ここまでの処理を関数にまとめる

ここまで書いてきた処理を関数にしましょう。引数にはファイル一覧があるシート(マクロ本体)を受け取れるようWorksheetを定義しておきます。

ファイル一覧があるシートを引数で指定するのは、様々なシートを扱うため、確実に対象シートにアクセスするためとなります。

Private Sub CombineFiles(sh As Worksheet)
    Dim cnt As Long
    Dim rowIdx As Long
    Dim readWb As Workbook
    Dim newWb As Workbook
    
    cnt = 0
    rowIdx = 1
    
    While sh.Cells(10 + cnt, 2).Value <> ""
        If cnt = 0 Then
            Set newWb = Workbooks.Add
            '新規Workbookを作成する
        End If
        
        'ファイルを読み取り専用で開く
        Set readWb = Workbooks.Open(sh.Cells(10 + cnt, 2).Value, ReadOnly:=True)
        
        readWb.Sheets(1).UsedRange.Select
        readWb.Sheets(1).UsedRange.Copy
        
        '転記
        newWb.Sheets(1).Paste Destination:=newWb.Sheets(1).Range("A" & rowIdx)
        readWb.Application.CutCopyMode = False
        rowIdx = rowIdx + readWb.Sheets(1).UsedRange.Rows.Count
        
        readWb.Close
        
        cnt = cnt + 1
    Wend
End Sub

これをファイル一覧作成終わった後で呼び出すようにします。これで完成となります。

完成コード

作成したコードの全文になります。

Private Sub btnExec_Click()
    Call FileList
End Sub

以下はすべて標準モジュールに記載をします。

Public Sub FileList()

    Dim rowIdx As Long
    Dim path As String
    Dim fs As Object
    Dim f As Object
    
    path = ActiveSheet.Cells(2, 3).Value
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    '先頭行を設定。10行目からスターとするようにします。
    rowIdx = 10
    
    For Each f In fs.GetFolder(path).Files
        If fs.GetExtensionName(f.path) = "xlsx" Then
            ActiveSheet.Cells(rowIdx, 2).Value = f.path 'B列にフルパスを表示
            rowIdx = rowIdx + 1
        End If
    Next f
    
    'ファイルを読み取り専用で開いて転記をする
    Call CombineFiles(ActiveSheet)
    
End Sub
Private Sub CombineFiles(sh As Worksheet)
    Dim cnt As Long
    Dim rowIdx As Long
    Dim readWb As Workbook
    Dim newWb As Workbook
    
    cnt = 0
    rowIdx = 1
    
    While sh.Cells(10 + cnt, 2).Value <> ""
        If cnt = 0 Then
            Set newWb = Workbooks.Add
            '新規Workbookを作成する
        End If
        
        'ファイルを読み取り専用で開く
        Set readWb = Workbooks.Open(sh.Cells(10 + cnt, 2).Value, ReadOnly:=True)
        
        readWb.Sheets(1).UsedRange.Select
        readWb.Sheets(1).UsedRange.Copy
        
        '転記
        newWb.Sheets(1).Paste Destination:=newWb.Sheets(1).Range("A" & rowIdx)
        readWb.Application.CutCopyMode = False
        rowIdx = rowIdx + readWb.Sheets(1).UsedRange.Rows.Count
        
        readWb.Close
        
        cnt = cnt + 1
    Wend
End Sub

まとめ

今回は、複数ファイルを1ファイルにまとめるマクロを作成方法を紹介しました。

それほど難しい処理はないので、手順がわかれば簡単に作成できます。やり方はいろいろあるので、今回した紹介が正解ということはありません。自分が理解できるやり方で実装できればOKです。

実行した主なポイントは以下の通りです。

Point
  • ファイルの一覧作成は、Scripting.FileSystemObjectを使う
  • ボタンを追加して、作成処理を呼び出す
  • ファイルの読み込みは1ファイルずつ行う
  • まとめファイルへはコピー&ペーストで実行する

今回した方法は最低限のやり方です。コピーの形式を変更したい、対象ファイルに詳細条件を追加したい、エラー発生時にメッセージを出したいなどの処理は必要に応じて追加をしてください。

少しでもお役に立てば、幸いです。

スポンサーリンク
よかったらシェアしてね!
  • URLをコピーしました!
  • URLをコピーしました!

この記事を書いた人

旅好き職業プログラマ。文系大学卒業後、ITソフトウエア開発会社に勤務してプログラミング言語を学ぶ。現在は転職し、プロジェクトマネージャ的ポジションで生産管理システムの開発にあたる。
得意言語は、VB、VB.NET、C#.NET、Java、SQLなど。

目次