Найти нужное и окрасить в нужный цвет

[Ципихович Эндрю]

здравствуйте код

Sub Замена_текста_с_нужным_цветом_шрифта()
'избавляемся от всех полей=сначала выделяем весь документ Конрол+A, затем Конрол+Шифт+Эф9
ActiveDocument.Range.Fields.Unlink
'шрифт всего документа окрасить в чёрный цвет
ActiveDocument.Range.Font.ColorIndex = wdBlack
With Selection.Find
 'очистить формат поиска
 .ClearFormatting
 'искать нужное только в тексте с шрифтом чёрного цвета
 .Font.Color = wdBlack
 'искать текст
 .Text = "123"
 'заменять на текст
 '.Replacement.Text = ""
 'цвет шрифта у текста, который нужно заменить
 .Replacement.Font.Color = wdColorRed
End With
'выполнить все замены
Application.Selection.Find.Execute Replace:=WdReplace.wdReplaceAll
 
End Sub

что-то не срабатывает, как подправить?
это нужно для того, что замены будут в цикле и после выделения текста 123 в красный цвет уже не находило
1
2
3
спасибо

[Ципихович Эндрю]

решил, спасибо всем кто заглядывал в топик))

Sub Замена_текста_с_нужным_цветом_шрифта_финиш()
vFindText = Array("123", "234")
'избавляемся от всех полей=сначала выделяем весь документ Конрол+A, затем Конрол+Шифт+Эф9
ActiveDocument.Range.Fields.Unlink
'шрифт всего документа окрасить в чёрный цвет
ActiveDocument.Range.Font.ColorIndex = wdBlack
For i = 0 To UBound(vFindText)
    With ActiveDocument.Range.Find
        'искать нужное только в тексте с шрифтом чёрного цвета
        .Font.ColorIndex = wdBlack
        .Text = vFindText(i)
        Debug.Print .Text
        'окрасить нужное шрифтом красного цвета
        .Replacement.Font.ColorIndex = wdRed
        .Execute Replace:=wdReplaceAll
    End With
Next i
MsgBox$ "Конец"
End Sub