Sub Copier_Word()
Dim chemin$, doc$, Wapp As Object, ac As Range
chemin = ThisWorkbook.Path & "\" 'dossier à adapter éventuellement
doc = Dir(chemin & "Doc Word.docx")
If doc = "" Then MsgBox "Document Word introuvable !", 48: Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
On Error GoTo 0
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open chemin & doc 'ouvre le document Word
Wapp.activedocument.Range.Copy 'copier
Application.ScreenUpdating = False
Set ac = ActiveCell 'mémorise
[E4].Select
ActiveSheet.Paste 'coller
ac.Select
ac.Copy ac 'vide le presse-papier
Wapp.Quit 'ferme Word
End Sub