[Résolu] Éviter les boucles pour créer le tableau

Sub CopierTableau()
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim fichier As String
Dim B, C, P


'Chemin du doc dans le même dossier qu'Excel
fichier = ThisWorkbook.Path & "\Modele.doc"


Set AppWord = New Word.Application
AppWord.Visible = True

Application.DisplayAlerts = False
Application.WindowState = xlMinimized

'Copie les données Excel
ThisWorkbook.Worksheets("Feuil1").Range("A1").CurrentRegion.Copy

'Ouvre le document Word
Set DocWord = AppWord.Documents.Open(fichier, ReadOnly:=False)

'Colle les données dans Word
DocWord.Range.Paste

'Appliquer les bordures + formatage
With DocWord
'Ajustement automatique des lignes et des colonnes
.Tables(1).AutoFitBehavior wdAutoFitWindow
.Tables(1).AllowAutoFit = True

  Application.ScreenUpdating = False
 'Traitement des lignes contour du tableau
    For B = -4 To -1
        With .Range.Borders(B)
            .Visible = True
            .Color = wdColorDarkRed
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth025pt
        End With
    Next
      
     'Traitement des colonnes
    For Each C In .Tables(1).Range.Columns
        With C.Borders(wdBorderHorizontal)
            .Visible = True
            .Color = wdColorGray125
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
     Next

     'Traitement des lignes
     For Each L In .Tables(1).Range.Rows
            With L.Borders(wdBorderVertical)
                .Visible = True
                .Color = wdColorGray125
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth050pt
            End With
    Next
 End With
    
'Supprime la sélection dans Excel
Application.CutCopyMode = False
'Enregistre les modifications
DocWord.Save
Application.WindowState = xlNormal

  'Ferme le document
'AppWord.Application.Quit
End Sub