複数のCSVデータファイルを複数シートに一括取込み

１　ファイル構成など

　thisworkbookと同じ階層に、「処理対象」フォルダを作成しておく。取り込みたいCSVをすべて「処理対象」フォルダに格納。フォルダ内には余分なファイルは入れないこと。thisworkbookには「ファイル名一覧表」というシートを作成しておく。

２　機能説明

　thisworkbookの「ファイル名一覧表」シートのA１セルから下方向に処理対象フォルダ内のファイル名リストを作成。作成したリストをもとに、シートを追加しながらCSVを取り込む。大量に取り込むことを想定して、ファイル名一覧表には各シートへのハイパーリンクをつけておく。　 

３　コード

Option Explicit
'=======親マクロ=======
Sub csvファイルデータの行数目視確認()
    Call createFileNameList        'ファイル名一覧表作成
    Call DeleteWS                  'シート削除
    Call inputCSVData             'CSV取込
    ThisWorkbook.Sheets(1).Select
End Sub

'=======子マクロ=======
'ファイル名一覧表作成
Private Sub createFileNameList()
     '「ファイル名一覧」シート初期化
    ThisWorkbook.Sheets("ファイル名一覧表").Cells.Clear
    
    Dim sFileName As String
    sFileName = Dir(ThisWorkbook.path & "\処理対象\*")
    Dim i As Long: i = 1
    '「処理対象」フォルダ内のファイル数すべての分についてループ
    Do While sFileName <> ""
        ThisWorkbook.Sheets("ファイル名一覧表").Range("A" & i).Value = sFileName
        sFileName = Dir()
        i = i + 1
    Loop
End Sub

'「ファイル名一覧表」以外のシートをすべて削除
Private Sub DeleteWS()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "ファイル名一覧表" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
End Sub

Private Sub inputCSVData()
    Dim wsList
    Set wsList = ThisWorkbook.Sheets("ファイル名一覧表")
    Dim i
    For i = 1 To wsList.Cells(Rows.Count, 1).End(xlUp).Row
        With ThisWorkbook.Sheets.Add(after:=Sheets(ThisWorkbook.Sheets.Count))
            Dim sFilePath As String
            sFilePath = ThisWorkbook.path & "\処理対象\" & wsList.Range("A" & i).Value
            'シート名を取り込んだファイル名に変更
            .Name = Dir(sFilePath)
            
'' ****取込パターンA　最もシンプル（冒頭の0消えて構わないとき）（鵜原研修所）。Excelも取り込める。
''            https://excel-ubara.com/excelvba5/EXCEL111.html
'            Workbooks.Open sFilePath
'            ActiveWorkbook.Sheets(1).Cells.Copy
'            '追加したシートに転記
'            .Range("A1").PasteSpecial
'            'ファイル閉じるときにクリップボード上のデータをどうするか確認されて止まるのを防ぐためクリップボード放す
'            Application.CutCopyMode = False
'            ActiveWorkbook.Close savechanges:=False
'' ****取込パターンAここまで

'' ****取込パターンB　””で囲まれたtxt,csvに対応する必要が生じたためパターンBに変更
            With .QueryTables.Add( _
                Connection:="TEXT;" & sFilePath, _
                Destination:=.Range("$A$1"))
                .AdjustColumnWidth = True           '列幅オートフィットオン
                .TextFilePlatform = 932
                .TextFileTextQualifier = xlTextQualifierDoubleQuote  ' 文字列の引用符は「”」
                .TextFileTabDelimiter = False       'タブ区切りオフ
                .TextFileSemicolonDelimiter = False 'セミコロン区切りオフ
                .TextFileCommaDelimiter = True      'カンマ区切りオン
                .TextFileSpaceDelimiter = False     'スペース区切りオフ
                .Refresh BackgroundQuery:=False
                .Delete
            End With
'' ****取込パターンBここまで
            
            '最終行のセルをアクティブにしておく
            .Cells(Rows.Count, 1).End(xlUp).Select
        End With
        
        
        'ファイル名一覧表に各シート最終行へのハイパーリンクを付与。
        ThisWorkbook.Sheets("ファイル名一覧表").Hyperlinks.Add _
            anchor:=wsList.Range("A" & i), _
            Address:="", _
            SubAddress:=Dir(sFilePath) & "!" & Cells(Rows.Count, 1).End(xlUp).Address
            
        'ファイル名一覧表に、取込データの最終行番号を入力
        wsList.Range("B" & i).Value = ThisWorkbook.Sheets(Dir(sFilePath)).Cells(Rows.Count, 1).End(xlUp).Row
        sFilePath = Dir()
    Next i
End Sub