Excel to Word VBA The formatting does not apply to the correct text

I'm trying to write a code to transfer an Excel file to Word with proper formatting, but when I set the format for one row, it gets applied to the next row instead.

Sub ExportToWordModifiedExcelData()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim i As Integer
    Dim colA As String, colB As String, colC As String, colD As String
    Dim cycleCount As Integer 

   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0

   
    Set wdDoc = wdApp.Documents.Add
    wdApp.Visible = True

    
    header1 = "IV. 31. b."
    header2 = "Forensic and criminal records"
    header3 = "(Acta sedrialia et criminalia)"

    cycleCount = 0 
    Const wdPageBreak = 1   
    

    
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row 
        colA = Cells(i, 1).Value 
        colB = Cells(i, 2).Value 
        colC = Cells(i, 3).Value 
        colD = Cells(i, 4).Value 

        
        If cycleCount = 3 Then
            wdDoc.Paragraphs.Last.Range.InsertBreak wdPageBreak 
            cycleCount = 0 
        End If

       
        With wdDoc.Content
            .InsertAfter header1 & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 18
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With

        
        With wdDoc.Content
            .InsertAfter header2 & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 16
                .Font.Bold = False
                .ParagraphFormat.Alignment = 1
            End With
        End With

                With wdDoc.Content
            .InsertAfter header3 & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 14
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With
        
        wdDoc.Content.InsertAfter vbCrLf    

       
        With wdDoc.Content
            .InsertAfter colB & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 16
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With

        
        With wdDoc.Content
            .InsertAfter colC & " " & colD & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 26
                .Font.Bold = True
                .ParagraphFormat.Alignment = 2
            End With
        End With

        
        With wdDoc.Content
            .InsertAfter colA & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 16
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With

        
         If cycleCount < 2 Then
            wdDoc.Content.InsertAfter vbCrLf
        End If

        
        cycleCount = cycleCount + 1
    Next i
End Sub

With the current code, I get the expected result, but it's quite frustrating, so it should be that header1 has Font.size=16 and Font.Bold=True, header2 Font.size=18 and Font.Bold=True, header3 Font.size=16 and Font.Bold=False, etc.

Try (untested):

Sub ExportToWordModifiedExcelData()
Dim wdApp As Object, wdDoc As Object, i As Long
Dim colA As String, colB As String, colC As String, colD As String
Const wdAlignParagraphLeft As Long = 0
Const wdAlignParagraphCenter As Long = 1
Const wdAlignParagraphRight As Long = 2
Const header1 As String = "IV. 31. b."
Const header2 As String = "Forensic and criminal records"
Const header3 As String = "(Acta sedrialia et criminalia)"

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
On Error GoTo 0

With wdApp
  .Visible = True
  .ScreenUpdating = False
  Set wdDoc = .Documents.Add
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    colA = Cells(i, 1).Value: colB = Cells(i, 2).Value
    colC = Cells(i, 3).Value: colD = Cells(i, 4).Value
    With wdDoc.Range
      If i > 1 Then
        If (i - 1) Mod 3 = 0 Then .Characters.Last.InsertBefore vbCr & Chr(12)
      End If
      .InsertAfter vbCr & header1
      With .Paragraphs.Last.Range
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Font.Size = 18
        .Font.Bold = True
      End With
      .InsertAfter vbCr & header2
      With .Paragraphs.Last.Range
        .Font.Size = 16
        .Font.Bold = False
      End With
      .InsertAfter vbCr & header3
      With .Paragraphs.Last.Range
        .Font.Size = 14
        .Font.Bold = True
      End With
      .InsertAfter vbCr & colB
      With .Paragraphs.Last.Range
        .Font.Size = 16
        .Font.Bold = True
      End With
      .InsertAfter vbCr & colC & " " & colD
      With .Paragraphs.Last.Range
        .Font.Size = 26
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphRight
      End With
      .InsertAfter vbCr & colA
      With wdDoc.Paragraphs.Last.Range
        .Font.Size = 16
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
      End With
    End With
  Next i
  wdDoc.Range.Characters.First.Delete
  .ScreenUpdating = True
End With
End Sub