複数のフォルダーに含まれている (例)「item.csv」を全て、結合して１つのCSVファイルを新たに作成します

複数のCSVファイルを1つにまとめる必要があり、これも数十件あると手作業では、うんざりするためVBAで作成しました。
※複数のフォルダーに含まれている (例)「item.csv」を全て、結合して１つのCSVファイルを新たに作成します。
※サブフォルダーを含めた、全てのフォルダーを検索します。
※1行目のみタイトルで残して、残りは内容のみ結合されます。

実行方法

・E１に「フォルダーパス」を入力する
　※例　C:\Users\suzukimotors\Desktop\test

・E2に「ファイル名」を入力する
　※例　item.csv

・VBAエディタを起動します（Alt + F11キー）。

・「挿入」メニューから「モジュール」を選択して、新しいモジュールを作　成します。

・下記のコードをモジュールウィンドウに貼り付けます。

・マクロを実行します（Alt + F8キー、作成したマクロを選択して「実行」）。

Sub CombineCSVFilesIncludingAllColumns()
    Dim folderPath As String
    Dim outputPath As String
    Dim firstFile As Boolean
    Dim wkbAll As Workbook
    Dim targetSheet As Worksheet
    
    ' FileSystemObjectの初期化
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' E1からフォルダーパスを取得
    folderPath = ThisWorkbook.Sheets(1).Range("E1").Value
    ' 出力ファイルのパス
    outputPath = folderPath & "\完成.csv"
    
    ' 最初のファイルフラグを設定
    firstFile = True
    
    ' 作業用ブックを作成し、最初のシートを取得
    Set wkbAll = Workbooks.Add
    Set targetSheet = wkbAll.Sheets(1)
    
    ' 指定フォルダー内のファイルを処理するための再帰的なサブルーチンを呼び出す
    ProcessFolder folderPath, fso, targetSheet, firstFile
    
    ' 結合したデータを保存
    wkbAll.SaveAs fileName:=outputPath, FileFormat:=xlCSV
    wkbAll.Close saveChanges:=False
    
    MsgBox "ファイルの結合が完了しました。"
End Sub

Sub ProcessFolder(folderPath As String, fso As Object, targetSheet As Worksheet, ByRef firstFile As Boolean)
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim wkbTemp As Workbook
    Dim ws As Worksheet
    Dim copyRange As Range
    Dim specifiedFileName As String
    
    ' E2から指定されたファイル名を取得
    specifiedFileName = ThisWorkbook.Sheets(1).Range("E2").Value
    
    Set folder = fso.GetFolder(folderPath)
    
    ' フォルダ内のファイルを処理
    For Each file In folder.Files
        If file.Name Like specifiedFileName Then ' "item.csv"からE2の値に変更
            ' ファイルを開く
            Set wkbTemp = Workbooks.Open(file.Path)
            Set ws = wkbTemp.Sheets(1)
            
            ' コピーする範囲を設定
            Dim lastRow As Long
            Dim lastColumn As Long
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            Set copyRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastColumn))
            
            ' 最初のファイルからは全ての行をコピー、それ以外はタイトル行を除いてコピー
            If firstFile Then
                copyRange.Copy targetSheet.Cells(1, 1)
                firstFile = False
            Else
                copyRange.Offset(1, 0).Resize(copyRange.Rows.Count - 1).Copy _
                    targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
            End If
            
            ' 一時ブックを閉じる
            wkbTemp.Close saveChanges:=False
        End If
    Next file
    
    ' サブフォルダーに対しても同様に処理
    For Each subFolder In folder.SubFolders
        ProcessFolder subFolder.Path, fso, targetSheet, firstFile
    Next subFolder
End Sub