Sub Remplacer()
Dim cherche$, remplace$, chemin$, Wapp As Object, doc$, Wd As Object, i
cherche = [D4] 'à adapter
remplace = [D6] 'à adapter
If cherche = "" Or remplace = "" Then Exit Sub
chemin = ThisWorkbook.Path & "\"
On Error Resume Next 'si Word n'est pas déjà ouvert
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
doc = Dir(chemin & "*.docx") '1er document Word du dossier
While doc <> ""
Wapp.Documents(doc).Close False 'ferme le document s'il est ouvert
Set Wd = Wapp.Documents.Open(chemin & doc)
Wapp.Selection.WholeStory
With Wapp.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = cherche
.Replacement.Text = remplace
.Execute Replace:=2 'wdReplaceAll
End With
If Not Wd.Saved Then Wd.SaveAs chemin & Left(doc, Len(doc) - 5) & "-Modification-" & Format(Date, "dd-mm-yyyy") & ".docx"
Wd.Close 'ferme le document Word
doc = Dir 'document suivant
Wend
If Wapp.Documents.Count = 0 Then Wapp.Quit 'ferme Word si aucun document n'est ouvert
End Sub