将Excel分割成独立的CSV文件 – VBAmacros

我已经看到过这样的一些问题，但是我对VBA不够了解，无法根据我的需求定制代码。 基本上，我有一个包含100,000行的电子表格，我需要将电子表格分成具有CSV格式（总共50个CSV文件）的2000行文件。 但是，每个文件都必须包含原始电子表格（名字，姓氏，电子邮件等）顶部的“标题行”。有人可以帮助我使用VBAmacros来完成此任务吗？ 我忘了把我到目前为止的代码：

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 

对我来说，这似乎应该工作，但没有任何反应，当我运行它。 有任何想法吗？ （注意：PATH GOES HERE被replace为文件的path）

Answer 1

有一个类似的需求和OP的解决scheme工作，除了我没有把循环中的新的CSV的打开和closures，以不会崩溃的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