フォルダ内のCSVファイルを統合するマクロ その3

今回は、その2で作成した
『同じフォルダ内にあるCSVファイルをコピー範囲の開始行をinputboxで指定してコピペして統合するマクロ』
に一番右のセルにCSVファイル名の【】内の文字を記入するコードを追加しました。

Sub tougou03()

'フォルダを選択
    Dim folderPath As Variant
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        folderPath = .SelectedItems(1)
    End With

'Dir関数でCSVファイル名を取得
    Dim buf As String
    buf = Dir(folderPath & "\" & "*.csv")
    Debug.Print buf        'ファイル名を確認

'貼り付け元の「請求統合.xlsx」ファイルを開いて最初のシートを指定
    Dim bath As Workbook
    Set bath = Workbooks.Open(folderPath & "\" & "請求統合.xlsx")
    Dim tougouWs As Worksheet
    Set tougouWs = bath.Worksheets(1)

'CSVファイルの転記位置が上から何行目かをインプットボックスで指定
'（「j」が空白を入力されたときにメッセージを出したいので、Long型ではなくString型を指定）
    Dim j As String
    j = InputBox("CSVファイルの転記の開始は何行目ですか？（半角英数で入力してください）")

    If j = "" Then
        MsgBox "空白が入力されました。最初からやり直してください"
        Exit Sub
    End If

'CSVファイルの一番右下のセルの位置
    Dim maxRows As Long
    maxRows = Cells(1, Columns.Count).End(xlToLeft).Column

'ループ開始・CSVファイルの名前が空白になったら（取得できなかったら）ループから外れる
    Do While buf <> ""

'「請求統合.xlsx」の最終行を取得
        With tougouWs
            Dim bathLastLine As Long
            bathLastLine = .Cells(Rows.Count, 1).End(xlUp).Row
        End With

'CSVファイルの最初のシートを取得
            Dim wb As Workbook
            Set wb = Workbooks.Open(folderPath & "\" & buf)
            Dim ws As Worksheet
            Set ws = wb.Worksheets(1)

'CSVファイルの最下行を取得
'最終行：lastLine
            Dim csvLastLine As Long
            csvLastLine = ws.Cells(Rows.Count, 1).End(xlUp).Row
            
'一番右のセルにCSVのファイル名を記入
            ws.Range(Cells(j, maxRows + 1), Cells(csvLastLine, maxRows + 1)).Value = buf
            
'範囲指定してコピー（クリップボード）
            ws.Range(Cells(j, 1), Cells(csvLastLine, maxRows + 1)).Copy

'「請求統合.xlsx」のA列の最終行の次のセルを指定し貼り付け
            With tougouWs
                .Activate
                .Cells(bathLastLine + 1, 1).Activate
            End With
            ActiveSheet.Paste

'CSVファイルを保存せずに閉じる
            wb.Application.CutCopyMode = False
            wb.Saved = True
            wb.Close

'次のCSVファイルを指定する
            buf = Dir()
    Loop

'一番右のセルのSCVのファイル名の【】内のみを残して置換しセルA1を選択する
    With tougouWs
        .Activate
        bathLastLine = .Cells(Rows.Count, 1).End(xlUp).Row
        With Range(Cells(1, maxRows + 1), Cells(bathLastLine, maxRows + 1))
            .Replace What:="【", Replacement:=""
            .Replace What:="】*", Replacement:=""
        End With
        Range("A1").Select
    End With

'「請求統合.xlsx」を保存して閉じる
    bath.Save
    bath.Close

End Sub

【】内の文字列を抜き出しには置換で不要部分を削りました。
最後にセルA1を選択してから保存して閉じるようにしました。

2つ目のマクロ作成も、これで一旦完了とします。
1つ目に比べると変数を使うことに慣れてきた気もします。

次回は
『フィルター機能などを使ってシートごとに必要な行を転記する』
マクロを作りたいと思います。