Excel Macro: split workbook

Question

I’ve got a workbook with 90000 lines and three worksheets (Sheet1, Sheet2, Sheet3)

Sheet 1 has the main data (90000 lines)

Sheet 2 has some data

Sheet 3 has some data

What I want is to split the data in sheet 1 into 5000 lines, copy sheet 2 and sheet 3 as it is and then save it as “filename-1”. I want to do this for all lines. I also need the headers in all split files. I want to save this in xml format.

If anyone can help will be great!

I have currently come until here, which splits sheet1 only and does not copy the headers and sheet2 and 3. And does not save it as xml. [ for sample purposes I’ve left this to save after every 5 rows]

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

sheet 2 and 3 copies will all the split worksheets. therefore, a new workbook will have header and 5000 lines from sheet 1, whole of sheet 2 and whole of sheet 3. — woollen19
You know how to "New Workbook", "Copy Rows" and "Copy Worksheet", I think this should not a problem to complete the whole task. For save as xml, you can search in Stack Overflow or google, it have a lot of sample for your reference. — Prisoner
@Prinsor, I actually do not know how to copy rows, worksheet. I have made the above code based on googling. Any help is appreciated! I've just got an hour to fix this :( — woollen19
I'm sorry that you may go to wrong place, you can ask specific question in Stack Overflow, but not writing service. — Prisoner

woollen19 woollen19 · Accepted Answer · 2017-07-21T02:22:05

Below is the code that does the trick!! May be helpful to someone.

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 Macro: split workbook

1 Answers