Small tweaking to a script that breaks sheet into multiple sheets with the headers' row included in every sheet

[Saeed Rasool Afridi]

Code:
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 Sub
Dom



Hi, I used a small script from a thread almost 9 years old. It helped me but the last sheet the macro tried to create, gave me an error which made me conclude, that the remaining data did not have sufficient rows in it.

My data has 1048576 rows in it and I had the code to create new sheets every 40,000 rows, the last sheet was blank because 2576 rows were available instead of 40,000.
I also need the headers' row to show on every new sheet created.

Can anyone please help?

 

[Fluff]

Untested, but try

Sub test()
    Dim lastRow As Long, myRow As Long, myBook As Workbook, Sht As Worksheet
    Set Sht = ThisWorkbook.Sheets("Sheet1")
    lastRow = Sht.Cells(Rows.Count, 1).End(xlUp).Row
    For myRow = 2 To lastRow Step 40000
        Set myBook = Workbooks.Add
        Sht.Rows(1).Copy myBook.Sheets("sheet1").Range("A1")
        If myRow <= 100576 Then
            Sht.Rows(myRow & ":" & myRow + 39000).EntireRow.Copy myBook.Sheets("Sheet1").Range("A2")
        Else
            Sht.Rows(myRow & ":" & Rows.Count).EntireRow.Copy myBook("sheets1").Range("A2")
        End If
    Next myRow
End Sub

 

[Saeed Rasool Afridi]

Untested, but try

Sub test()
    Dim lastRow As Long, myRow As Long, myBook As Workbook, Sht As Worksheet
    Set Sht = ThisWorkbook.Sheets("Sheet1")
    lastRow = Sht.Cells(Rows.Count, 1).End(xlUp).Row
    For myRow = 2 To lastRow Step 40000
        Set myBook = Workbooks.Add
        Sht.Rows(1).Copy myBook.Sheets("sheet1").Range("A1")
        If myRow <= 100576 Then
            Sht.Rows(myRow & ":" & myRow + 39000).EntireRow.Copy myBook.Sheets("Sheet1").Range("A2")
        Else
            Sht.Rows(myRow & ":" & Rows.Count).EntireRow.Copy myBook("sheets1").Range("A2")
        End If
    Next myRow
End Sub

Thanks for your help, but this did not do anything at all after i hit F5. also please explain why it says 100576 and 39000 instead of 1048576 and 40000.
And where should i enter the name of my workbook that is being worked on. Plus my data is in three columns. Just an FYI.

I hope I'm not being demanding and thanks for your help

 

[Fluff]

Couple of typos in there. try

Sub test()
    Dim lastRow As Long, myRow As Long, myBook As Workbook, Sht As Worksheet
    Set Sht = ThisWorkbook.Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
    lastRow = Sht.Cells(Rows.Count, 1).End(xlUp).Row
    For myRow = 2 To lastRow Step 40000
        Set myBook = Workbooks.Add
        Sht.Rows(1).Copy myBook.Sheets("sheet1").Range("A1")
        If myRow < 1040000 Then
            MsgBox myRow & vbLf & myRow + 39999
            Sht.Rows(myRow & ":" & myRow + 39999).EntireRow.Copy myBook.Sheets("Sheet1").Range("A2")
        Else
        MsgBox myRow & "Last"
            Sht.Rows(myRow & ":" & Rows.Count).EntireRow.Copy myBook("sheets1").Range("A2")
        End If
    Next myRow
End Sub

The code needs to go in the workbook that you want to run this on & the part in red needs to be changed to match the name of your sheet.
The two numbers were the typos.
If the row number exceeds 1040000 then you dont have enough rows left to copy, hence the check.
The 39999 is 40000 -1 as the header row is not included in the loop

 

[Saeed Rasool Afridi]

Thanks for your help but it still did not do anything.
Are you suggesting I should not have more than 1040000 rows in the sheet?

What I did was i removed data and only kept 1040000 rows.
It started making sheets but prompted me on every sheet it created to hit ok.
This would take me forever to click okay.
Can you please remove the message box?
I want to know can I use this script with 1040001 rows on the sheet?

 

[Fluff]

You an use the macro for any number of rows up to a limit of 1048575
To remove the message box just delete the 2 lines starting MsgBox

 

[Saeed Rasool Afridi]

I had to make a few adjustments but it did work. Thanks alot for helping me @Fluff
You are awesome!

 

[Fluff]

Glad to help & thanks for the feedback