Try the following code. As you'll see, you really don't need all your indicators for where to insert the breaks. All this stuff:
SECTION 2 START
SECTION 2 END
SECTION 4 START
SECTION 4 END
can be deleted from the document.
What I don't understand, though, is why your document isn't pre-configured with the required Sections & page layouts.
Code:
Option Explicit
Sub InsertSummaryTable()
Application.ScreenUpdating = False
Dim RngTbl As Range, RngSctn As Range
With ActiveDocument.Range
With .Find
.Text = "Chapter 2"
.Style = "Heading 1"
.Format = True
.Wrap = wdFindContinue
.Execute
End With
If .Find.Found = True Then
Set RngSctn = .Paragraphs.Last.Next.Range.Paragraphs.Last.Range
With RngSctn
.Characters.First.InsertBreak wdSectionBreakNextPage
.Start = .Start + 1
.Sections.First.PageSetup.DifferentFirstPageHeaderFooter = False
.End = .End + 1
.Characters.Last.InsertBreak wdSectionBreakNextPage
.Sections.First.PageSetup.Orientation = wdOrientLandscape
End With
End If
With .Find
.Text = "Chapter 3"
.Style = "Heading 1"
.Execute
End With
If .Find.Found = True Then
Set RngSctn = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Set RngTbl = RngSctn.Tables(1).Range.Characters.Last.Next.Paragraphs.First.Range
With RngSctn
.End = .End + 1
.Characters.First.InsertBreak wdSectionBreakNextPage
.Characters.Last.InsertBreak wdSectionBreakNextPage
.Start = .Start + 1
.Sections.First.PageSetup.Orientation = wdOrientLandscape
End With
ActiveDocument.TablesOfContents.Add Range:=RngTbl, _
RightAlignPageNumbers:=False, UseHeadingStyles:=True, _
UpperHeadingLevel:=5, LowerHeadingLevel:=5, _
IncludePageNumbers:=False, UseHyperlinks:=False
DoEvents
With RngTbl
.End = .End + 1
.End = .Fields(1).Result.End
.Fields(1).Unlink
.ConvertToTable Separator:=wdSeparateByTabs, _
NumColumns:=6, NumRows:=.Paragraphs.Count, AutoFit:=False
DoEvents
With .Tables(1)
.Borders.Enable = True
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.Range.Cut
End With
End With
RngSctn.Tables(1).Select
Selection.Collapse wdCollapseEnd
Selection.PasteAppendTable
End If
End With
Application.ScreenUpdating = True
End Sub