Excel 宏:拆分工作簿

Question

我有一个包含 90000 行和三个工作表(工作表 1、工作表 2、工作表 3(的工作簿

表 1包含主要数据(90000 行(

表 2有一些数据

表 3有一些数据

我想要的是将工作表 1 中的数据拆分为 5000 行，按原样复制工作表 2 和工作表 3，然后将其另存为"文件名-1"。我想对所有行都这样做。我还需要所有拆分文件中的标头。我想将其保存为 xml 格式。

如果有人能帮忙，那就太好了！

我目前一直到这里，它只拆分工作表 1，不复制标题和工作表 2 和 3。并且不会将其另存为 xml。[出于示例目的，我将其留作每 5 行后保存]

Sub Macro1()
Dim rLastCell As Range
Dim rCells As Range
Dim strName As String
Dim lLoop As Long, lCopy As Long
Dim wbNew As Workbook
With ThisWorkbook.Sheets(1)
Set rLastCell = .Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious)
For lLoop = 1 To rLastCell.Row Step 5
lCopy = lCopy + 1
Set wbNew = Workbooks.Add
.Range(.Cells(lLoop, 1), .Cells(lLoop + 5, .Columns.Count)).EntireRow.Copy _
Destination:=wbNew.Sheets(1).Range("A1")
wbNew.Close SaveChanges:=True, Filename:="Chunk" & lCopy & "Rows" & lLoop & "-" & lLoop + 5
Next lLoop
End With
End Sub

Answer 1

下面是可以解决问题的代码！！可能对某人有帮助。

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