Option Explicit

'***外部データの取込みで、まとめて1回で***
Sub データ取込()
    Dim FName As String
    Dim trSh As Worksheet
    Dim LastRow As Long, LR As Long
    Dim i As Long

    '取込用シートを変数に入れる
    Set trSh = Worksheets("取込用")

    'ファイル名を変数に取得
    FName = Dir(ThisWorkbook.Path & "\CSV保存用\*.CSV")

    'ファイル名書込行の初期値
    i = 2

    '画面の更新を止める
    'ブックを開く行為がありませんので、これは無くてもいいような気もしますが、一応。
    Application.ScreenUpdating = False

    '取得したファイル名がある間作業を繰り返す
    Do While FName <> ""
        '外部データの取り込みでデータを「取込用」シートに取得
        With trSh.QueryTables.Add(Connection:= _
            "TEXT;" & ThisWorkbook.Path & "\CSV保存用\" & FName _
            , Destination:=trSh.Range("A1"))
            .TextFileCommaDelimiter = True
            .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 5, 1, 1, 1)
            .Refresh BackgroundQuery:=False
            .Delete
        End With

        '和暦の6桁の数字を日付に変換
        With trSh
            LR = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Range("AA2:AA" & LR).FormulaR1C1 = "=TEXT(RC7+19880000,""0000!/00!/00"")*1"
            .Range("G2:G" & LR).Value = .Range("AA2:AA" & LR).Value
            .Columns("G:G").NumberFormatLocal = "ge.m.d"
            .Columns("AA:AA").Clear
        End With

        '取り込んで、整形もしたデータを、「Data」シートに追加
        With Worksheets("Data")
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            'データシートに項目行を除いて追加
            trSh.Range("A1").CurrentRegion.Offset(1).Copy Destination:=.Cells(LastRow + 1, 1)
        End With
        '取込用シートをクリア
        trSh.Range("A1").CurrentRegion.Clear

        '取り込んだファイル名をセルに入力
        With Worksheets("取込ファイル名")
            .Cells(i, 1).Value = FName
            i = i + 1
        End With

        '次のファイル名を取得
        FName = Dir()
    Loop

    '画面の更新を戻す
    Application.ScreenUpdating = True
    MsgBox "取込が終わりました。"
End Sub