Buenas.

Os dejo el código fuente para reemplazar texto dentro del documento en varios archivos Word (hasta 500 por defecto) con extensión docx simultáneamente y de forma automatizada. Es necesario crear la macro en VBA. Una vez creada al ejecutarse pide que selecciones los Word que quieres cambiar, después pedirá el texto a buscar y el texto a reemplazar.  Se ha probado en Word 365 y 2019.

Reemplazará hasta 500 documentos, pero se puede personalizar ese dato en el código.

Sub Reemplazar()
'
'Reemplazar - Por @oscardelacuesta
'Macro para reemplazar texto en varios documentos Word simultáneamente.
'Se ha probado en Office 365 y 2019


Dim StrDocumento As Document
Dim StrEncontrar As String
Dim StrReemplazar As String

Dim Dialogo As FileDialog, GetStr(1 To 500) As String 'Establecer el límite de archivos

On Error Resume Next 'Por si se genera algún error inesperado que avance el proceso

Set Dialogo = Application.FileDialog(msoFileDialogFilePicker)

With Dialogo
    .Filters.Clear
    .Filters.Add "Todos los Ficheros Word ", "*.docx", 1
    .AllowMultiSelect = True
    i = 1
   
    If .Show = -1 Then
        For Each stiSelectedItem In .SelectedItems
            GetStr(i) = stiSelectedItem
            i = i + 1
        Next
        i = i - 1
    End If

    Application.ScreenUpdating = False
    StrEncontrar = InputBox("Encontrar:", "Palabra a buscar", StrEncontrar)
    StrReemplazar = InputBox("Reemplazar con:", "Palabra a reemplazar", StrReemplazar)
    
    For y = 1 To i Step 1
        Set StrDocumento = Documents.Open(FileName:=GetStr(j), Visible:=True)
        Windows(GetStr(y)).Activate
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = StrEncontrar  'Cadena a encontrar
            .Replacement.Text = StrReemplazar  'Cadena a reemplazar
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Application.Run macroname:="NEWMACROS"
        ActiveDocument.Save
        ActiveWindow.Close
    Next
   
    Application.ScreenUpdating = True

End With


MsgBox "Operación completada con éxito. Salu2 > @oscardelacuesta", vbInformation


End Sub