【VBA】データを複数のCSVファイルに出力するツールを作ってみた！

Sub writeCSV()

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)

' 出力フォルダを作成
Dim outFolder As String
outFolder = ActiveWorkbook.Path & "/output_" & Format(Now, "yyyymmddHHMMSS")
MkDir outFolder

'---CSV出力処理---
Dim csvFile As String
Dim maxCol As Integer
Dim i As Long, j As Long
'★データ開始行：４
i = 4

'最大項目数の取得、CSVファイルをオープン
maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
Open csvFile For Output As #1

Do While ws.Cells(i, 1).Value <> ""
    '★データ開始列：2行目
    j = 2
    Do While j < maxCol
        Print #1, ws.Cells(i, j).Value & ",";
        j = j + 1
    Loop
    Print #1, ws.Cells(i, j).Value & vbCr;
    i = i + 1
    '次の行のファイル名と異なる場合出力
    If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
        Close #1
        '次のファイル名が入力されている場合
        '最大項目数の取得、CSVファイルをオープン
        If ws.Cells(i, 1).Value <> "" Then
            maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
            csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
            Open csvFile For Output As #1
        End If
    End If
Loop
MsgBox outFolder & " に書き出しが完了しました！"
End Sub

' 出力フォルダを作成
Dim outFolder As String
outFolder = ActiveWorkbook.Path & "/output_" & Format(Now, "yyyymmddHHMMSS")
MkDir outFolder

'最大項目数の取得、CSVファイルをオープン
maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
Open csvFile For Output As #1

Dim i As Long, j As Long
'★データ開始行：４
i = 4

・・・

Do While ws.Cells(i, 1).Value <> ""
    '★データ開始列：2行目
    j = 2
    Do While j < maxCol
        Print #1, ws.Cells(i, j).Value & ",";
        j = j + 1
    Loop
    Print #1, ws.Cells(i, j).Value & vbCr;
    i = i + 1
    ・・・
        End If
    End If
Loop

Do While ws.Cells(i, 1).Value <> ""
    ・・・
    '次の行のファイル名と異なる場合出力
    If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
        Close #1
        '次のファイル名が入力されている場合
        '最大項目数の取得、CSVファイルをオープン
        If ws.Cells(i, 1).Value <> "" Then
            maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
            csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
            Open csvFile For Output As #1
        End If
    End If
Loop