Split Every N Rows From Worksheet Into New Worksheets with Header

[amittheexcel]

Hi,

I have the codes which can split the data into new worksheet, but it is not considering the header while doing this.

can anyone help me to solve this.

Sub test()
Dim lastRow As Long, myRow As Long, myBook As Workbook
lastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For myRow = 2 To lastRow Step 900
Set myBook = Workbooks.Add
ThisWorkbook.Sheets("Sheet1").Rows(myRow & ":" & myRow + 899).EntireRow.Copy myBook.Sheets("Sheet1").Range("A1")
Next myRow
End SubThank you.

Amit

 

[Fluff]

Try

Sub test()
    Dim lastRow As Long, myRow As Long, myBook As Workbook
    
    lastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For myRow = 2 To lastRow Step 900
        Set myBook = Workbooks.Add
        With ThisWorkbook.Sheets("Sheet1")
            .Rows(1).Copy myBook.Sheets("Sheet1").Range("A1")
            .Rows(myRow & ":" & myRow + 899).Copy myBook.Sheets("Sheet1").Range("A2")
        End With
    Next myRow
End Sub