Sub ProcessH1Breaks()
Application.ScreenUpdating = False
Dim Rng1 As Range, Rng2 As Range, Sctn As Section, HdFt As HeaderFooter, i As Long
Set Rng1 = ActiveDocument.Range(0)
Set Rng2 = ActiveDocument.Range(0)
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    'Find all Section breaks
    .Text = "^b"
    .Replacement.Text = "^&"
    'Makes sure the Section break's Style = Normal
    .Replacement.Style = "Normal"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
    'Find all "Heading 1" text
    .Text = ""
    .Style = "Heading 1"
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    Rng1.End = .Duplicate.Start + 1
    Rng2.End = .Duplicate.Start - 1
    'Make sure there is a Next Page Section break before the "Heading 1" paragraph
    If Rng1.Sections.Count = Rng2.Sections.Count Then
      Set Sctn = ActiveDocument.Sections.Add(.Duplicate.Characters.First, wdSectionNewPage)
    Else
      Set Sctn = .Duplicate.Sections.First
    End If
    'Restart the Section's page numbering
    For Each HdFt In Sctn.Headers
      With HdFt
        .LinkToPrevious = False
        .PageNumbers.RestartNumberingAtSection = True
        .PageNumbers.StartingNumber = 1
      End With
    Next
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  'Repeat making the Sections break Style = Normal
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^b"
    .Replacement.Text = "^&"
    .Replacement.Style = "Normal"
    .Forward = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
  'Make sure all changes in page orientation continue page numbering,
  'PROVIDED the Section doesn't start with Heading 1.
  For i = 2 To .Sections.Count
    If .Sections(i).PageSetup.Orientation <> .Sections(i - 1).PageSetup.Orientation Then
      If .Sections(i).Range.Paragraphs(1).Style <> "Heading 1" Then
        For Each HdFt In .Sections(i).Headers
          With HdFt
            .LinkToPrevious = True
          End With
        Next
      End If
    End If
  Next
End With
Set Rng1 = Nothing: Set Rng2 = Nothing: Set Sctn = Nothing
Application.ScreenUpdating = True
End Sub