Autres Exporter des tableau Excel vers Word sous VBA

Sub Export()
Dim chemin$, doc$, Wapp As Object, n&
chemin = ThisWorkbook.path & "\" 'à adapter
doc = "Model_Documentation.docx" 'à adapter
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents(doc).Close False 'si le document est ouvert on le ferme
With Wapp.Documents.Open(chemin & doc) 'ouvre le document Word
    '---suppression des tableaux existants---
    For n = .Tables.Count To 1 Step -1
        .Tables(n).Delete 'RAZ
    Next
    '---copie le 1er et 2ème tableau Excel après le 1er signet---
    Err = 0
    Evaluate("Tableau_1:Tableau_2").Copy
    n = .Bookmarks("Tableau_TVA").Start + Len(.Bookmarks("Tableau_TVA")) + 1
    If Err Then MsgBox "Tableau ou signet non définis !", 48: GoTo 1
    .Range(n, n).Select
    Wapp.Selection.Paste
    Application.CutCopyMode = 0
    '---copie le 3ème tableau Excel après le 2ème signet---
    [Tableau_3].Copy
    n = .Bookmarks("Tableau_archivage").Start + Len(.Bookmarks("Tableau_archivage")) + 1
    If Err Then MsgBox "Tableau ou signet non définis !", 48: GoTo 1
    .Range(n, n).Select
    Wapp.Selection.Paste
1   Application.CutCopyMode = 0
    '---pour réduire la hauteur des tableaux---
    For n = 1 To .Tables.Count
        .Tables(n).Range.ParagraphFormat.SpaceAfter = 3
    Next
    '---cadrage en haut (facultatif)---
    '.Range(1, 1).Select
End With
AppActivate "Word" 'activation facultative
End Sub

Private Sub Traitement_Archivage()
    Dim ctrl As Object
    [Tableau_3].Copy
    For Each ctrl In WordDoc.SelectContentControlsByTitle("Tableau_Archivage")
        ctrl.Range.PasteExcelTable False, False, True
    Next
End Sub