Question

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

第1页有主要数据（90000行）

第2页有一些数据

第3页有一些数据

我想要的是将工作表1中的数据拆分为5000行，复制工作表2和工作表3，然后将其另存为“文件名-1” 即可。我想为所有线路做这个。我还需要所有拆分文件中的标题。我想以xml格式保存它。

如果有人能提供帮助就会很棒！

我目前已经到了这里，它只拆分sheet1而不复制header和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

Excel宏：拆分工作簿

1 个答案: