Splitting data with horizontal page breaks – VBA macro modification

[wired]

I found Ron de Bruin’s Macro and it will work for my application with some modifications.
1. Name sheets with cell A? of the active sheet that is being copied, instead of using the revolving page numbering.
2. Autofit the cells that are copied to the new sheets.
Would anyone like to kindly assist?

Sub Create_Separate_Sheet_For_Each_HPageBreak()    Dim HPB As HPageBreak
    Dim RW As Long
    Dim PageNum As Long
    Dim Asheet As Worksheet
    Dim Nsheet As Worksheet
    Dim Acell As Range


    'Sheet with the data, you can also use Sheets("Sheet1")
    Set Asheet = ActiveSheet


    If Asheet.HPageBreaks.Count = 0 Then
        MsgBox "There are no HPageBreaks"
        Exit Sub
    End If


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'When the macro is ready we return to this cell on the ActiveSheet
    Set Acell = Range("A1")


    'Because of this bug we select a cell below your data
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    Application.Goto Asheet.Range("A" & Rows.Count), True


    RW = 1
    PageNum = 1


    For Each HPB In Asheet.HPageBreaks
        If HPB.Type = xlPageBreakManual Then
        'Add a sheet for the page
        With Asheet.Parent
            Set Nsheet = Worksheets.Add(after:=.Sheets(.Sheets.Count))
        End With


        'Give the sheet a name
        On Error Resume Next
        Nsheet.Name = "Page " & PageNum
        If Err.Number > 0 Then
            MsgBox "Change the name of : " & Nsheet.Name & " manually"
            Err.Clear
        End If
        On Error GoTo 0


        'Copy the cells from the page into the new sheet
        With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.location.Row - 1, "K")).Copy _
                    Nsheet.Cells(1)
        End With
        ' If you want to make values of your formulas use this line also
          Nsheet.UsedRange.Value = Nsheet.UsedRange.Value


        RW = HPB.location.Row
        PageNum = PageNum + 1
        End If
    Next HPB


    Asheet.DisplayPageBreaks = False
    Application.Goto Acell, True


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[wired]

The edit post timed out on me... my revision is:
I found Ron de Bruin’s Macro and it will work for my application with some modifications.
1. Name sheets with cell A? of the active sheet that is being copied, instead of using the revolving page numbering.
2. I figured this out and updated the code.
3. Keep the header.
Would anyone like to kindly assist?

Sub Create_Separate_Sheet_For_Each_HPageBreak()
    Dim HPB As HPageBreak
    Dim RW As Long
    Dim PageNum As Long
    Dim Asheet As Worksheet
    Dim Nsheet As Worksheet
    Dim Acell As Range


    'Sheet with the data, you can also use Sheets("Sheet1")
    Set Asheet = ActiveSheet


    If Asheet.HPageBreaks.Count = 0 Then
        MsgBox "There are no HPageBreaks"
        Exit Sub
    End If


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'When the macro is ready we return to this cell on the ActiveSheet
    Set Acell = Range("A1")


    'Because of this bug we select a cell below your data
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    Application.Goto Asheet.Range("A" & Rows.Count), True


    RW = 1
    PageNum = 1


    For Each HPB In Asheet.HPageBreaks
        If HPB.Type = xlPageBreakManual Then
        'Add a sheet for the page
        With Asheet.Parent
            Set Nsheet = Worksheets.Add(after:=.Sheets(.Sheets.Count))
        End With


        'Give the sheet a name
        On Error Resume Next
        Nsheet.Name = "Page " & PageNum
        If Err.Number > 0 Then
            MsgBox "Change the name of : " & Nsheet.Name & " manually"
            Err.Clear
        End If
        On Error GoTo 0


        'Copy the cells from the page into the new sheet
        With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.location.Row - 1, "K")).Copy _
                    Nsheet.Cells(1)


        End With
            Columns("A:G").Select
    Columns("A:G").EntireColumn.AutoFit
        ' If you want to make values of your formulas use this line also
          Nsheet.UsedRange.Value = Nsheet.UsedRange.Value


        RW = HPB.location.Row
        PageNum = PageNum + 1
        End If
    Next HPB


    Asheet.DisplayPageBreaks = False
    Application.Goto Acell, True


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  End Sub