VBA. ошибка с кодом

Sub автозамена()
Dim word As Object
Dim wl As Worksheet
Dim patch, name As String
 
Dim rWhat, rTo As String
 
 
 
Set wl = Workbooks(1).Worksheets(1)
Set word = CreateObject("Word.Application")
iPath = ActiveWorkbook.Path + ""
 
Dim i, j As Integer
 i = 1
 j = 1
 
wl.Activate
While (wl.Cells(i + 1, 1) <> "")
   Set word = CreateObject("Word.Application")
   word.Visible = True
   word.Activate
   word.Documents.Open Filename:=iPath + "Шаблон.docx", ReadOnly:=True
   word.Visible = True
   word.Activate
   j = 1
  While (wl.Cells(i + 1, j + 1) <> "")
    word.Selection.HomeKey ' Unit:=wdStory, Extend:=wdMove
    wl.Activate
     rWhat = Cells(1, 1 + j)
     rTo = Cells(i + 1, j + 1)
     word.Selection.Find.ClearFormatting
     word.Selection.Find.Replacement.ClearFormatting
     With word.Selection.Find
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
     
     
     
     word.Selection.Find.Execute FindText:=rWhat, _
     ReplaceWith:=rTo, Replace:=wdReplaceAll
     word.Run "paste"
  
    j = j + 1
    Wend
    NameFile = iPath & Cells(i + 1, 1).Text & ".docx"
    word.ActiveDocument.SaveAs Filename:=NameFile
    word.ActiveDocument.Close
    word.Quit
   
    i = i + 1
Wend
 
End Sub