Debug Help

[jtsuperman34]

Hello, I am using the below formula to create a new page after every page break. When I run this it works well until the last page break. I get the Debug error and then it does not put the information after the last page break into the worksheet.

Public Sub Copy_Each_Page_Break_Section_To_New_Worksheet()

    Dim reportWorksheet As Worksheet
    Dim saveActiveCell As Range
    Dim lastRow As Long, pageStartRow As Long
    Dim page As Long
    Dim newWorksheet As Worksheet
    
    'Look on the active sheet in the active workbook
    
    Set reportWorksheet = ActiveWorkbook.ActiveSheet
    Set saveActiveCell = ActiveCell
    
    With reportWorksheet
        
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        pageStartRow = 1
        
        'Copy rows in each page break section to new worksheet
        
        For page = 1 To .HPageBreaks.Count
            Set newWorksheet = .Parent.Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
            newWorksheet.Name = "Page " & page
            .Rows(pageStartRow & ":" & .HPageBreaks(page).Location.Row - 1).EntireRow.Copy newWorksheet.Range("A1")
            pageStartRow = .HPageBreaks(page).Location.Row
        Next
    
        If pageStartRow <= lastRow Then
        
            'Copy rows after last page break to new worksheet
            
            Set newWorksheet = .Parent.Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
            newWorksheet.Name = "Page " & page
            .Rows(pageStartRow & ":" & lastRow).EntireRow.Copy newWorksheet.Range("A1")
        
        End If
    
    End With
    
    'Restore active cell
    
    reportWorksheet.Activate
    saveActiveCell.Select
    
End Sub

 

[Hui]

It runs flawlessly for me, no errors?

Have you put the code in the Sheet1 worksheet object, like shown below or in a code module?

It needs to be in the Worksheet object

 

[Marc L]

Already solved in another forum …​

​