Замена каждого n-го вхождения

Sub Finder()
'wordexpert.ru
Dim sFind As String
Dim iSubCounter, iCounter As Integer
'sFind = Ваше значение, по которому хотите искать
'в Selection.Range = (там где Case1\Case2) указываете значения, на которые будете менять
sFind = "приложе"
iSubCounter = 0
iCounter = 0
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindContinue
.Forward = True
.Text = sFind
Do While .Execute = True
    If iSubCounter = 2 Then
        iCounter = iCounter + 1
        If iCounter = 3 Then iCounter = 0
        Select Case iCounter
            Case 1: Selection.Range = "буйнопомешанный"
            Case 2: Selection.Range = "харизматичный лидер"
        End Select
        iSubCounter = 0
    Else
        iSubCounter = iSubCounter + 1
    End If
Loop
End With
End Sub