Word [VBA] Scinder Tableau Saut de Page

Sub Création_Exemple()
Application.ScreenUpdating = False
ENTETE_DOC_EXEMPLE
EXEMPLE_TABLEAU
End Sub

Sub ENTETE_DOC_EXEMPLE()
  With Selection
    .TypeText Text:="RAISON SOCIALE EXPEDITEUR"
    .ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(10.25), Alignment:=0, Leader:=0
    .TypeText Text:=vbTab & "Ville, le "
    .InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField:=True, DateLanguage:=1036, CalendarType:=0, InsertAsFullWidth:=False
    .TypeParagraph: .TypeText Text:="ADRESSE 1"
    .TypeParagraph: .TypeText Text:="ADRESSE 2"
    .TypeParagraph: .TypeText Text:="CP VILLE"
    .TypeParagraph: .TypeText Text:="TITRE DU DOCUMENT"
    .TypeParagraph: .TypeParagraph: .TypeParagraph
  End With
  With ActiveDocument.Paragraphs(5)
    .Alignment = 1: .Range.Bold = True
    .Range.Font.Size = 14: .Range.Borders(1).LineStyle = 7
  End With
End Sub
Sub EXEMPLE_TABLEAU()
Dim objTable As Table, i As Long
Set objTable = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=120, NumColumns:=4)
objTable.Borders.InsideLineStyle = 1
objTable.Borders.OutsideLineStyle = 1
Randomize
With objTable
    For i = 1 To objTable.Rows.Count
      .Cell(i, 1).Range.Text = i
      .Cell(i, 2).Range.Text = Chr(Int((90 - 65 + 1) * Rnd + 65)) & "|" & Right(Application.Build, 4) + i
      .Cell(i, 3).Range.Text = Chr(Int((57 - 48 + 1) * Rnd + 48)) & "|" & Application.UserName
      .Cell(i, 4).Range.Text = Application.Language + i
    Next i
End With
End Sub

Sub Insere_Saut_II()
Dim rw As Word.Row
Application.ScreenUpdating = False
With ActiveDocument.Tables(1)
  Set rw = .Rows(2)
  While Not rw Is Nothing
    If Len(rw.Cells(1).Range.Text) > 1 Then
      'If rw.Range.Information(wdActiveEndPageNumber) > Page Then
      '.Rows.Add beforerow:=rw 'insére une ligne vide au dessus - Pas OK
      'rw.Range.InsertParagraphBefore '-> insère un paragraphe dans la 1ère cellule - Pas OK
      rw.Range.InsertBreak Type:=wdPageBreak
      rw.Range.InsertBreak Type:=wdColumnBreak '-> Bingo !!!!
    End If
    Set rw = rw.Next
  Wend
End With
End Sub

Sub Insere_Saut_II()
    Dim rngToCopy As Range
    Dim rw As Word.Row
    Application.ScreenUpdating = False
   
    With ActiveDocument
        Set rngToCopy = .Range(.Paragraphs(1).Range.Start, .Paragraphs(5).Range.End)
        rngToCopy.Copy
        With .Tables(1)
            Set rw = .Rows(2)
            While Not rw Is Nothing
                If Len(rw.Cells(1).Range.Text) > 1 Then
                    rw.Range.InsertBreak Type:=wdPageBreak
                    rw.Range.InsertBreak Type:=wdColumnBreak    '-> Bingo !!!!
                     ' Déplacement de la sélection sur la page venant d'être créée
                    Selection.GoTo wdGoToPage, which:=wdGoToNext, Name:=rw.Range.Information(wdActiveEndPageNumber)
                     ' réduire la sélection au point d'insertion puis coller
                    Selection.Range.Collapse
                    Selection.Range.Paste
                End If
                Set rw = rw.Next
            Wend
        End With
    End With
End Sub

Sub Traitement()
Application.ScreenUpdating = False
m_A
m_B
End Sub
Sub m_A()
Dim rw As Word.Row
With ActiveDocument.Tables(1)
  Set rw = .Rows(2)
  While Not rw Is Nothing
    If Len(rw.Cells(1).Range.Text) > 1 Then
      rw.Range.InsertBreak Type:=wdPageBreak
      rw.Range.InsertBreak Type:=wdColumnBreak
    End If
    Set rw = rw.Next
  Wend
End With
End Sub
Sub m_B()
Dim i&, Rng As Range, Rng2 As Range
With ActiveDocument
    Set Rng2 = .Range(.Paragraphs(1).Range.Start, .Paragraphs(5).Range.End)
        For i = 2 To .ComputeStatistics(wdStatisticPages)
          Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
          Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
              With Rng
                .Collapse wdCollapseStart
                .FormattedText = Rng2
              End With
        Next
    End With
End Sub