Sub InsertTable()
    Dim tempTable As Paragraph
    Dim lineCount As Long
    
    Application.ScreenUpdating = False
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    
    lineCount = 0
    strTableloc = "INSERT TABLE HERE"
    strSection2start = "SECTION 2 START"
    strSection2end = "SECTION 2 END"
    strSection4start = "SECTION 4 START"
    strSection4end = "SECTION 4 END"
    
    For Each tempTable In ActiveDocument.Paragraphs
     If tempTable.Style = ActiveDocument.Styles(wdStyleHeading5) Then
        tempTable.Range.Editors.Add wdEditorEveryone
        lineCount = lineCount + 1
     End If
    Next
    
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    Selection.Copy
    Set rng1 = ActiveDocument.Range
    With rng1
        With .Find
            .Text = strTableloc
            If .Execute = True Then
                ActiveDocument.Range(rng1.Start, rng1.End).Select
            End If
        End With
    End With

    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatPlainText)
    'select the whole list
    Selection.MoveUp Unit:=wdLine, Count:=lineCount, Extend:=wdExtend
    'create table from the list
    Selection.ConvertToTable Separator:=wdSeparateByTabs, _
        NumColumns:=6, NumRows:=lineCount ', AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .LeftPadding = 0
        .RightPadding = 0
    End With
    
    Selection.Cut
    Selection.PasteAppendTable
    
    InsertSectionBrake strSection2start
    InsertSectionBrake strSection2end
    InsertSectionBrake strSection4start
    InsertSectionBrake strSection4end
    
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToAbsolute, Count:=2
    Selection.PageSetup.Orientation = wdOrientLandscape
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToAbsolute, Count:=4
    Selection.PageSetup.Orientation = wdOrientLandscape
    
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    Application.ScreenUpdating = True
    
End Sub

Sub InsertSectionBrake(reference)

    Set rng1 = ActiveDocument.Range
        With rng1
            With .Find
                .Text = reference
                If .Execute = True Then
                    ActiveDocument.Range(rng1.Start, rng1.End).Select
                End If
            End With
        End With
        
    Selection.InsertBreak Type:=wdSectionBreakNextPage
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=2

End Sub