Try this one (tested):
Based on searching for header A1:C1 of first page
Sub PageSeparator()
Dim HeaderCount As Long, _
CountNdx As Long, _
LastFound As Variant, _
LastRow As Variant, _
Found As Variant, _
TestCell As Range
Application.ScreenUpdating = False
HeaderCount = [countif(A:A,A1)]
LastRow = Sheets("All").Cells(Rows.Count, 1).End(xlUp).Row
' pageboundaries() holds the address of the found headers and the address of the cell just above the next one found
ReDim PageBoundaries(1 To HeaderCount, 1 To 2) As String
PageBoundaries(1, 1) = "A1"
PageBoundaries(HeaderCount, 2) = "A" & LastRow
With
LastFound = .Range("A1").Address(0, 0)
For CountNdx = 2 To HeaderCount
Set Found = .Find(What:=Range("A1").Value, _
LookAt:=xlPart, _
After:=Range(LastFound), _
SearchOrder:=xlByRows)
If Found Is Nothing Then Exit For
LastFound = Found.Address(0, 0)
PageBoundaries(CountNdx - 1, 2) = Found.Offset(-1, 0).Address(0, 0) ' the last row is one row up from the next found header
PageBoundaries(CountNdx, 1) = Found.Address(0, 0)
Next CountNdx
End With 'Sheets("all").Cells
For CountNdx = 1 To HeaderCount
Sheets("all").Range(PageBoundaries(CountNdx, 1), PageBoundaries(CountNdx, 2)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Name = Range("M6").Value
'adjust column width of copied sheet to match sheet "all" column
For Each TestCell In Range("A9:M9")
TestCell.ColumnWidth = Sheets("All").Range(TestCell.Address).ColumnWidth
Next TestCell
'get the last row of the copied sheet
Set LastRow = Cells(Rows.Count, 1).End(xlUp)
'adjust the row height of the copied sheet to match the sheet "all row
For Each TestCell In Range("A1", LastRow.Address)
TestCell.RowHeight = Sheets("All").Range(TestCell.Address).RowHeight
Next TestCell
Range("A1").Select
Sheets("All").Select
Application.CutCopyMode = False
Next CountNdx
Application.ScreenUpdating = True
End Sub
Bookmarks