将 Excel 拆分为单独的 CSV 文件 - VBA 宏

Question

我见过一些这样的问题，但我对 VBA 的了解不足以根据我的要求自定义代码。基本上，我有一个包含 100,000 行的电子表格，我需要将电子表格拆分为 CSV 格式的 2,000 行文件（总共 50 个 CSV 文件）。但是，每个文件都必须在原始电子表格的顶部包含"标题行"（名字、姓氏、电子邮件等）有人可以帮助我使用 VBA 宏来完成此操作吗？我忘了输入到目前为止的代码：

Public Sub Split_2000_With_Column_Headings()
Dim inputFile As String, inputWb As Workbook
Dim lastRow As Long, row As Long, n As Long
Dim newCSV As Workbook
inputFile = "PATH GOES HERE"
Set inputWb = Workbooks.Open(inputFile)
With inputWb.Worksheets(1)
    lastRow = .Cells(Rows.Count, "A").End(xlUp).row
    Set newCSV = Workbooks.Add
    n = 0
    For row = 2 To lastRow Step 2000
        n = n + 1
        .Rows(1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
        .Rows(row & ":" & row + 2000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A2")
        'Save in same folder as input workbook with .xlsx replaced by (n).csv
        newCSV.SaveAs Filename:=Replace(inputWb.FullName, ".xlsx", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False
    Next
End With
newCSV.Close saveChanges:=False
inputWb.Close saveChanges:=False
End Sub

对我来说，这似乎应该有效，但当我运行它时什么也没发生。有什么想法吗？（注：路径去这里被替换为文件的路径）

Answer 1

有类似的需求，OP 的解决方案有效，除了我确实将新 CSV 的打开和关闭放在循环中以免使 Excel 崩溃：

    For row = 1 To lastRow Step 2000
        'add workbook inside the loop
        Set newCSV = Workbooks.Add
        n = n + 1
        .Rows(row & ":" & row + 2000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
        'save in same folder as input workbook with .xlsx replaced by (n).csv
        newCSV.SaveAs Filename:=Replace(inputWb.FullName, ".xlsx", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False
        'close workbook inside the loop
        newCSV.Close saveChanges:=False
    Next