Поиск и чередование фраз

Sub Макрос1()
Const FND = "мне нравятся твои булки"
Const RPL = "человек-молекула"
Dim r As Range, i&
  Set r = ActiveDocument.Range
  With r.Find
    .ClearFormatting
    .Text = FND
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = False
    While .Execute
      If i Mod 4 < 2 Then
        r.Text = RPL
        r.Collapse wdCollapseEnd
      End If
      i = i + 1
    Wend
  End With
End Sub

Const FND = "мне нравятся твои булки" 'строчки под замену
Const RPL = "человек-молекула"
Dim r As Range, i& 
  Set r = ActiveDocument.Range 'объявляем диапазон - весь документ
  With r.Find 'поиск со следующими параметрами
    .ClearFormatting 'удаляем форматирование
    .Text = FND 'что ищем
    .Forward = True 'ищем вперед
    .Wrap = wdFindStop 'завершить поиск по достижении конца диапазона - документа
    .Format = False 'выключить форматирование, чтобы это не значило)
    .MatchCase = False 'на регистр не смотреть
    .MatchWholeWord = True 'только текст целиком, если является частью слова то пропустить
    .MatchWildcards = False 'текст для поиска без подстановочных знаков, чтобы это не значило)
    While .Execute ' запускаем поиск, входим в цикл если что-то нашли.
'не совсем понятен алогритм работы, я так понимаю если написать "If (.Execute) then..." ничего не получится
      If i Mod 4 < 2 Then 'условие для замены/незамены
      r.Text = RPL  'получается весь диапазон документа съеживается до найденной строки,
' которую мы перезаписываем
      r.Collapse wdCollapseEnd 'тут происходит магия: сбрасывается диапазон в конечную позцию, 
'то бишь в конец замененной строки вроде как
      End If
      i = i + 1 'счетчик считает
    Wend