Sub transfertVersWord()
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim derl As Integer
Set AppWord = New Word.Application
Application.DisplayAlerts = True
AppWord.ShowMe
AppWord.Visible = True
'Ouvre le document Word
Set DocWord = AppWord.Documents.Open(ThisWorkbook.Path & "\document12.docx", ReadOnly:=False)
'recherche de la dernière ligne du tableau
derl = ThisWorkbook.Worksheets("Feuil1").Range("a65536").End(xlUp).Row
' Copie les données Excel
ThisWorkbook.Worksheets("Feuil1").Range("A1:B" & derl).Copy
' Colle les données dans Word
DocWord.Range.PasteSpecial
Application.CutCopyMode = False
DocWord.Application.ActiveDocument.Save
AppWord.Application.Quit
End Sub