Sub Doc_Word()
Dim chemin$, nomDoc$, Wapp As Object, Doc As Object, c As Range
chemin = ThisWorkbook.Path & "\"
nomDoc = "convention type_société_1.docx" 'nom à adapter
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
Set Doc = Wapp.Documents.Open(chemin & nomDoc) 'ouvre le document Word
With Sheets("DOC")
For Each c In .[A6:A22]
Doc.Bookmarks(c).Range = c(1, 3) 'signets Word
Next
Doc.SaveAs chemin & Trim(Replace(Replace(.[C7], "Mr", ""), "Mme", "")) & Format(Now, " yyyy-mm-dd hhmmss") & ".docx"
End With
AppActivate Wapp.Caption 'affiche le document Word
End Sub