1. 背景

過去に投稿した記事で複数のCSVファイルを1つのブックの各シートにまとめたいとの質問があった為作成しました。

2. ソースコード

取り敢えず、下記のコードをコピペすれば動作するはずです。素人のコードですので、読みづらい点はご容赦ください。

Option Explicit

Sub Main()
    Dim SelectedFiles As Variant '入力ファイル名の一覧
    Dim inputfile As String '入力ファイル名
    Dim OutputWB As Workbook '結合データ記入用ワークブック

    Set OutputWB = Workbooks.Add
    OutputWB.Worksheets(1).Name = "入力ファイル一覧"

    'エクスプローラーを起動し、ファイルを選択
    SelectedFiles = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", MultiSelect:=True)

    'CSVを読み込む
    Call ReadCSV(SelectedFiles, OutputWB)
End Sub

Private Sub ReadCSV(ByRef datafiles As Variant, ByVal wb As Workbook)
    Dim filecounter As Integer, arraycounter As Integer, rowcounter As Integer
    Dim buf As String
    Dim tmp As Variant, inputfile As Variant
    Dim pos As Integer
    
    filecounter = 1
    For Each inputfile In datafiles
        wb.Worksheets(1).Cells(filecounter, 1).Value = inputfile
        'データコピー先となるシートを追加
        wb.Worksheets.Add After:=wb.Worksheets(wb.Worksheets.Count)
        'シート名をcsvのファイル名に変更
        pos = InStrRev(inputfile, "\")
        wb.Worksheets(wb.Worksheets.Count).Name = Mid(inputfile, pos + 1)
        'コピー先の行数を初期化
        rowcounter = 1
        Open inputfile For Input As #1
        Do Until EOF(1)
            '一行分を読み込む
            Line Input #1, buf
            '区切り文字で分割する
            tmp = Split(buf, ",")
            For arraycounter = 0 To UBound(tmp)
                wb.Worksheets(1 + filecounter).Cells(rowcounter, arraycounter + 1).Value = tmp(arraycounter)
            Next
            rowcounter = rowcounter + 1
        Loop
        Close #1
        filecounter = filecounter + 1
    Next inputfile
End Sub

2-1. 変更点

今回のプログラムは過去に投稿した記事のプログラムを9割流用していますので、プログラムの流れはそちらをご確認ください。今回変更した点は、csvの値を記入する前に、新規にシート追加し、記入先を追加したシートにした点です。

Private Sub ReadCSV(ByRef datafiles As Variant, ByVal wb As Workbook)
    Dim filecounter As Integer, arraycounter As Integer, rowcounter As Integer
    Dim buf As String
    Dim tmp As Variant, inputfile As Variant
    Dim pos As Integer
    
    filecounter = 1
    For Each inputfile In datafiles
        wb.Worksheets(1).Cells(filecounter, 1).Value = inputfile
        'データコピー先となるシートを追加
        wb.Worksheets.Add After:=wb.Worksheets(wb.Worksheets.Count)
        'シート名をcsvのファイル名に変更
        pos = InStrRev(inputfile, "\")
        wb.Worksheets(wb.Worksheets.Count).Name = Mid(inputfile, pos + 1)
        'コピー先の行数を初期化
        rowcounter = 1
        Open inputfile For Input As #1
        Do Until EOF(1)
            '一行分を読み込む
            Line Input #1, buf
            '区切り文字で分割する
            tmp = Split(buf, ",")
            For arraycounter = 0 To UBound(tmp)
                wb.Worksheets(1 + filecounter).Cells(rowcounter, arraycounter + 1).Value = tmp(arraycounter)
            Next
            rowcounter = rowcounter + 1
        Loop
        Close #1
        filecounter = filecounter + 1
    Next inputfile
End Sub