Const fic_WORD As String = "C:\Users\STAPLE1600\Documents\ESSAIS_WORD\test.docx"
Option Base 1
Sub Copier_TableauxExcel_vers_Tables__WORD()
'Déclarations variables
Dim xlAry, tSignets, LO_rng As Excel.Range, i%, WordApp As Word.Application, wd_Doc As Word.Document, WordTable As Word.Table
xlAry = Array("Tableau1", "Tableau2", "Tableau3"): tSignets = Array("Signet_01", "Signet_02", "Signet_03")
'Figer rafraichissement écran & évenements
Application.ScreenUpdating = 0: Application.EnableEvents = 0
'création Objet Word
Set WordApp = CreateObject("Word.Application"): WordApp.Visible = True
'Ouvrir le document Word
Set wd_Doc = WordApp.Documents.Open(fic_WORD)
'Boucler sur le tableau des signets
For i = LBound(xlAry) To UBound(xlAry)
'copier les tableaux Excel (ListObject) un à un
Set LO_rng = Worksheets(1).ListObjects(xlAry(i)).Range: LO_rng.Copy
'les coller dans le document Word en tant que Table Word à l'emplacement des signets
'préalablement définis dans le document Word.
wd_Doc.Bookmarks(tSignets(i)).Range.PasteExcelTable False, False, False
'ajustement des Tables
Set WordTable = wd_Doc.Tables(i): WordTable.AutoFitBehavior (wdAutoFitWindow)
Next i
MsgBox "Traitement terminé", vbInformation, "Recopie Tableaux Excel vers Tables WORD"
'Rétablir rafraichissement écran & évenements et vider clipboard
Application.ScreenUpdating = -1: Application.EnableEvents = -1
Application.CutCopyMode = False
End Sub