[RESOLU] Remplacer date par une autre en fonction d'une liste excel

Sub CopRemp()
Dim Mot As String, Doc As String, AppWord As Object, DocWord As Object
Mot = Range("B2").Value
On Error GoTo Err1
Set AppWord = GetObject(, "Word.Application")
For each DocWord in AppWord.Documents
DocWord.Activate
With AppWord.Selection
.WholeStory
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
With .Find
.Text = "xxx" ' __________________________c'est ici que tu changes
.Replacement.Text = Mot
.Forward = True
.Wrap = 2
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
AppWord.DisplayAlerts = 0
.Find.Execute Replace:=2
AppWord.DisplayAlerts = -1
End With
Next
On Error GoTo 0
Exit Sub
Err1:
MsgBox "Erreur"
End Sub

Sub recherchedansword()
    Dim Cible As String
    Dim AppWord As Word.Application
    Dim DocWord As Word.Document
    Dim CollWord As Word.Words
    Dim x As Long, a As String, b As String

    Cible = "C:\Users\René\Downloads\docx dwld.docx"

    'Ouvre une instance Word
    Set AppWord = New Word.Application
    'Indiquez False pour garder l'application masquée
    AppWord.Visible = True

    'Ouvre le document Word
    Set DocWord = AppWord.Documents.Open(Cible)
    Set CollWord = DocWord.Content.Words

    'Boucle sur les mots du document
    For x = 1 To CollWord.Count - 2
        If InStr(1, CollWord(x) & CollWord(x + 1), "Dossier") > 0 Then
            a = CollWord(x + 4)
        End If

        If InStr(1, CollWord(x) & CollWord(x + 1), ",") > 0 Then
            b = CollWord(x + 3) & CollWord(x + 4) & CollWord(x + 5) & CollWord(x + 6) & CollWord(x + 7)
        End If
'résultat dans feuille
        If a <> "" And b <> "" Then
            l = l + 1
            Range("E" & l) = a: Range("F" & l) = b
            Exit For
        End If
    Next

    DocWord.Close True
    Set DocWord = Nothing
    AppWord.Quit
    Set AppWord = Nothing

End Sub