Не отрабатывает цикл

  Dim n As Range
    Dim m As Variant
    m = UserEntry + 4
    
    For Each n In Range("A:A")
    
   If n = UserEntry And n = UserEntry Then
    
     For Each row In ActiveSheet.Rows("m:" & r)
        With row
            номер = Trim$(.Cells(1))
            Filename = НоваяПапка & номер '& РасширениеСоздаваемыхФайлов
 
            pi.StartNewAction p, p + A, "Создание нового файла на основании шаблона", номер
            Set WD = WA.Documents.Add(ПутьШаблона): DoEvents
 
            pi.StartNewAction p + A / 3, p + A * 2 / 3, "Замена данных ...", номер
            For i = 1 To КоличествоОбрабатываемыхСтолбцов
                FindText = Cells(1, i): ReplaceText = Trim$(.Cells(i))
 
                ' так почему-то заменяет не всё (не затрагивает таблицу)
                'WA.Selection.Find.Execute FindText, , , , , , , wdFindContinue, False, ReplaceText, True
 
                pi.line3 = "Заменяется поле " & FindText
                With WD.Range.Find
                    .Text = FindText
                    .Replacement.Text = ReplaceText
                    .Forward = True
                    .Wrap = 1
                    .Format = False: .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    .Execute Replace:=2
                End With
                DoEvents
            Next i
            pi.StartNewAction p + A * 2 / 3, p + A, "Сохранение файла ...", номер, " "
            WD.SaveAs Filename: WD.Close False: DoEvents
            p = p + A
            
               
       End With
          Next row
       
      ' Else: If n = Empty Then Exit For
    
     Exit For
       End If
        Next n

For Each row In ActiveSheet.Rows(m & ":" & r)