【Excel VBA】CSVファイル(複数)を読み込む

複数のcsvファイルに格納されているデータをエクセルに貼り付けるマクロです。
今回はそれぞれのcsvファイルの1行目が列名で2行目以降がデータとなっている場合を例として取り上げます。（列名が1つ目のファイルにしか存在しない場合は別の機会に）

下の図のような同じ構成のcsvファイルのデータを取り込み、マクロを実行したエクセルファイルのA1セルを始点に取り込んだデータを出力します。

Sub 複数のcsvファイルデータ書き出し_1行目が列名の場合()

Dim folder_Path As String
Dim fso As Object
Dim filePath As String
Dim file As Object
Dim retsumei() As String
Dim data As Variant
Dim line As String
Dim i, j As Integer


 'フォルダダイアログを開いてデータを取り込むcsvファイルが格納されているフォルダを選択する
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "フォルダを選択してください"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
        folder_Path = .SelectedItems(1)
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folder_Path)

'選択したフォルダ内の全てのファイルに対して処理を行う
For Each file In folder.Files
    'ファイルの拡張子が.csvの場合に限りファイルを開く
    If Right(file.Name, 4) = ".csv" Then
        Set file = fso.OpenTextFile(file.Path)
            
            i = Range("A1048576").End(xlUp).Row
            
            '列名を取得する(1行目(i=1)を列名とする)
            retsumei = Split(file.ReadLine, ",")
                    
            '1行目(A1セル始点)に列名を出力する（2シート名以降は列名無視）
            If i = 1 Then
                For j = LBound(retsumei) To UBound(retsumei)
                    Cells(1, j + 1).Value = retsumei(j)
                Next j
            Else
            End If

        'データを読み込んでExcelシート(2行目以降)に出力する
        Do Until file.AtEndOfStream  'csvファイルの2行目～最終行目まで繰り返し
            line = file.ReadLine
            data = Split(line, ",")
                    
            For j = LBound(data) To UBound(data)
                Cells(i + 1, j + 1).Value = data(j)
            Next j
                
            i = i + 1
        Loop

        'csvファイルを閉じる
        file.Close
        
    End If
            
Next file


End Sub

同じ構成のcsvファイルデータ追加を考慮して、csvファイルの構成と同じく、Excelワークシートにおいても1行目のみ列名記入としているため、マクロ実行済みの状態で更にマクロを実行してcsvファイルを追加すると、最下行以降にcsvデータが追加されます。
例として、同じ複数のcsvファイルに対して2回マクロを実行した結果は下図の通りになります。