Content is out of order when using Excel VBA to create a Word document

The aim is to generate multiple different tables in a Word document from an Excel table.

The code should take the title from the first column, then use the other columns to generate a table. The title and tables are all created successfully, but they are in the wrong order in the document. The document shows title 1, then a page break, title 2, page break, then table 2 then table 1.

Why are the tables in the wrong order and why is the page break going above the tables?

Sub AddToWord()

Dim objWord
Dim objDoc
Dim ObjSelection
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Dim row_count As Integer
Dim col_count As Integer
Dim e As Integer
Dim row As Integer

Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Activate
row_count = 7
col_count = 2
e = ws.Range("A2", ws.Range("A2").End(xlDown)).Rows.Count

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
Set ObjSelection = objWord.Selection

objWord.Visible = True
objWord.Activate

For i = 1 To e
    If ws.Cells(i + 1, 12).Value \> 0 Then
        With ObjSelection
            .BoldRun
            .Font.Size = 14
            .TypeText ws.Cells(i + 1, 1).Value
            .BoldRun
        End With
        Set Table = objDoc.Tables.Add(ObjSelection.Range, row_count, col_count)
        With Table
            .Borders.Enable = True
            For j = 1 To row_count
                .Cell(j, 1).Range.InsertAfter ws.Cells(1, j + 1).Text
            Next j

            For j = 1 To row_count
                .Cell(j, 2).Range.InsertAfter ws.Cells(i + 1, j + 1).Text
            Next j
        End With

    
    
        ObjSelection.InsertBreak Type:=wdPageBreak
    End If

Next i

End Sub

The sheet looks like this:

Further along the sheet is a quantity section, which is for the IF statement to decide if that line is being used.

The code produces this:

The end result should be this:

The problem is that while using your Table object to put content in, the ObjSelection not get changed. The selection stays positioned after inserted bold run.

So after using your Table object to put content in, you need select the table, new set the ObjSelection, collapse the ObjSelection to end and then insert the page break.

...
        Set Table = objDoc.Tables.Add(ObjSelection.Range, row_count, col_count)
        With Table
        ...
        End With
        
        Table.Select
        Set ObjSelection = objWord.Selection
        wdCollapseEnd = 0
        ObjSelection.Collapse Direction:=wdCollapseEnd
        wdPageBreak = 7
        ObjSelection.InsertBreak Type:=wdPageBreak
...

Hint: Me used late bound objects, so wdCollapseEnd and wdPageBreak are not defined by not early bound Word.Application and must be set to values. If using early bound Word.Application via Tools-References this can be omitted.

It is essential to be aware of the range that is being updated by your code. In your snippet, the Selection range remains unchanged, hence the output does not align with your expectations.

Sub AddToWord()
    Dim objWord
    Dim objDoc
    Dim ObjSelection
    Dim i As Long
    Dim j As Long
    Dim ws As Worksheet
    Dim row_count As Long
    Dim col_count As Long
    Dim e As Long
    Dim row As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Activate
    row_count = 7
    col_count = 2
    e = ws.Range("A2", ws.Range("A2").End(xlDown)).Rows.Count
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objDoc.Content.Font.Size = 14
    Dim lastRng As Range, oTable
    With ActiveDocument.Characters
        For i = 1 To e
            If ws.Cells(i + 1, 12).Value > 0 Then
                Set lastRng = .Last
                lastRng.Text = ws.Cells(i + 1, 1).Value
                lastRng.Expand Word.wdParagraph
                lastRng.Font.Bold = True
                Set lastRng = .Last
                lastRng.InsertAfter vbCr
                lastRng.Font.Bold = wdToggle
                Set oTable = objDoc.Tables.Add(lastRng, row_count, col_count)
                With oTable
                    .Borders.Enable = True
                    For j = 1 To row_count
                        .Cell(j, 1).Range.Text = ws.Cells(1, j + 1).Text
                    Next j
                    For j = 1 To row_count
                        .Cell(j, 2).Range.Text = ws.Cells(i + 1, j + 1).Text
                    Next j
                End With
                .Last.InsertBreak Type:=wdPageBreak
            End If
        Next i
    End With
End Sub