макрос замены стиля у буквы

Sub макрос()
 
    Dim word As Range, counter As Long
    Dim i As Long, ii As Long
   
    For i = ActiveDocument.Words.Count To 1 Step -3
        counter = 0
        Set word = ActiveDocument.Words(i)
        For ii = word.Characters.Count To 1 Step -1
            If word.Characters(ii).Font.Size = 14 Then
                word.Characters(ii - 1).InsertAfter "а"
                With word.Characters(ii)
                    .Style = "Стиль1"
                End With
                counter = counter + 1
                If counter > 0 Then
                    Exit For
                End If
            End If
        Next ii
    Next i
end sub

Public Sub zamen()
    Dim word As Range, counter As Long
    Dim i As Long, ii As Long
   
    For i = ActiveDocument.Words.Count To 1 Step -3
        counter = 0
        Set word = ActiveDocument.Words(i)
        For ii = word.Characters.Count To 1 Step -1
            If word.Characters(ii).Font.Size = 14 Then
                word.Characters(ii - 1).InsertAfter "а"
               word.Characters(ii).Select
               Selection.Style = ActiveDocument.Styles("Стиль1")
 
                counter = counter + 1
                If counter > 0 Then
                    Exit For
                End If
            End If
        Next ii
    Next i
 
End Sub

Sub Стиль1()
'
' Стиль1 Макрос
'
'
    Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
    Selection.find.Replacement.Style = ActiveDocument.Styles("Стиль1 Знак")
    With Selection.find
        .Text = "а"
        .Replacement.Text = "а"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute Replace:=wdReplaceAll
End Sub

Sub FormatSelection() 
 With Selection.Font 
 .Name = "Times New Roman" 
 .Size = 14 
 .AllCaps = True 
 End With 
 With Selection.ParagraphFormat 
 .LeftIndent = InchesToPoints(0.5) 
 .Space1 
 End With 
End Sub

Sub Стиль1()
'
' Стиль1 Макрос
'
'
    Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
    Selection.find.Replacement.Style = ActiveDocument.Styles("Стиль1")
    With Selection.find
        .Text = "а"
        .Replacement.Text = "а"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute Replace:=wdReplaceAll
End Sub