Excel VBA批量导出为csv，共5个

我正在尝试将一些excel数据以5个数据行加1个标题的方式批量导出到.csv

我的第一个文件有4个数据行，应该是5加上标题，如下所示

latitude,longitude,altitude(m),heading(deg),curvesize(m),rotationdir,gimbalmode,gimbalpitchangle,actiontype1,actionparam1
1,-0.5643113,100,0,0,0,2,-90,1,0
2,-0.56499336,100,180,0,0,2,-90,1,0
3,-0.56499336,100,180,0,0,2,-90,1,0
4,-0.56499336,100,180,0,0,2,-90,1,0

而其余文件有5个数据行（这是正确的）

你知道我哪里出错了吗

Sub Export()
    Dim FileNum As Integer
    Dim Last_Row As Long
    Dim My_Range As Range
    Dim TotalFileNum As Integer
    Dim myStr As String
    Dim MYFILE As String
    Dim i As Integer
    Dim j As Long

    MYFILE = ThisWorkbook.Path & "\"

    FileNum = FreeFile
    Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
    Set My_Range = ActiveSheet.Range("A2:J" & Last_Row)

    Open MYFILE & "Litch 0.csv" For Output As #FileNum

    'Put out the headers
    myStr = Cells(1, 1).Value
    For i = 2 To 10
        myStr = myStr & "," & Cells(1, i).Value
    Next i
    Print #FileNum, myStr



    For j = 2 To Last_Row
        If (j - 1) Mod 5 = 0 Then
            Close #FileNum
            Open MYFILE & "Litch " & ((j - 1) \ 5) & ".csv" For Output As #FileNum

            'Put out the headers
            myStr = Cells(1, 1).Value
            For i = 2 To 10
                myStr = myStr & "," & Cells(1, i).Value
            Next i
            Print #FileNum, myStr
            TotalFileNum = (j \ 5) + 1
        End If

        'Put out the values
        myStr = Cells(j, 1).Value
        For i = 2 To 10
            myStr = myStr & "," & Cells(j, i).Value
        Next i
        Print #FileNum, myStr

    Next j
    Close #FileNum
End Sub

---

提前感谢您的帮助

也许在循环中做每件事都更好

Option Explicit

Sub Export()
Dim FileNum As Integer
Dim Last_Row As Long
Dim My_Range As Range
Dim TotalFileNum As Integer
Dim myStr As String
Dim MYFILE As String
Dim i As Integer
Dim j As Long

    MYFILE = ThisWorkbook.Path & "\"    

    Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
    Set My_Range = ActiveSheet.Range("A2:J" & Last_Row)

    For j = 1 To Last_Row

        If j = Last_Row Then
            Close #FileNum
            Exit For
        End If

        If (j - 1) Mod 5 = 0 Then

            FileNum = FreeFile
            Open MYFILE & "Litch " & ((j - 1) \ 5) & ".csv" For Output As #FileNum

            'Put out the headers
            myStr = Cells(1, 1).Value
            For i = 2 To 10
                myStr = myStr & "," & Cells(1, i).Value
            Next i
            Print #FileNum, myStr
            TotalFileNum = (j \ 5) + 1

        End If

        'Put out the values
        myStr = Cells(j + 1, 1).Value
        For i = 2 To 10
            myStr = myStr & "," & Cells(j + 1, i).Value
        Next i

        Print #FileNum, myStr

        If j Mod 5 = 0 Then
            Close #FileNum
        End If

    Next j

End Sub

---

我在底部的打印行上得到了一个错误的文件名或编号是的，当然。抱歉，您必须在写入五行后关闭该文件。你能解决这个问题吗？我试过了，但我要么把它放错了地方，要么问题出在其他地方，但第一个文件的头重复了两次，仍然只有4个数据行改变了代码，这意味着我还调整了单元格中j的偏移量。请在下次提到代码不是您的。

Option Explicit

Sub Export()
Dim FileNum As Integer
Dim Last_Row As Long
Dim My_Range As Range
Dim TotalFileNum As Integer
Dim myStr As String
Dim MYFILE As String
Dim i As Integer
Dim j As Long

    MYFILE = ThisWorkbook.Path & "\"    

    Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
    Set My_Range = ActiveSheet.Range("A2:J" & Last_Row)

    For j = 1 To Last_Row

        If j = Last_Row Then
            Close #FileNum
            Exit For
        End If

        If (j - 1) Mod 5 = 0 Then

            FileNum = FreeFile
            Open MYFILE & "Litch " & ((j - 1) \ 5) & ".csv" For Output As #FileNum

            'Put out the headers
            myStr = Cells(1, 1).Value
            For i = 2 To 10
                myStr = myStr & "," & Cells(1, i).Value
            Next i
            Print #FileNum, myStr
            TotalFileNum = (j \ 5) + 1

        End If

        'Put out the values
        myStr = Cells(j + 1, 1).Value
        For i = 2 To 10
            myStr = myStr & "," & Cells(j + 1, i).Value
        Next i

        Print #FileNum, myStr

        If j Mod 5 = 0 Then
            Close #FileNum
        End If

    Next j

End Sub