Excel宏：拆分工作簿

Question

我有一本包含90000行和三個工作表（Sheet1，Sheet2，Sheet3）的工作簿

工作表1具有主要數據（90000行）

工作表2有一些數據

工作表3有一些數據

我想要的是將工作表1中的數據分成5000行， 照原樣復制工作表2和工作表3，然后將其保存為“ filename-1” 。 我想對所有行都這樣做。 我還需要所有拆分文件中的標題。 我想將其保存為xml格式。

如果有人可以幫助，那就太好了！

我目前一直到這里為止，這里僅拆分sheet1，並且不復制標頭以及sheet2和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