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