Word dosyasında bul değiştir makrosu

[sametozyavuz]

aşağıda word için hazırlanmış olan (lemruk) bul değiştir makrom var.
fakat ben bu işlemi aynı anda birçok kelime için yapmak istiyorum.
yani;
a1 ---> b1
a2 ---> b2
a3 ---> b3
a4 ---> b4
...
a15 ---> b15
olacak şekilde.

Sub uc()

Set WD = CreateObject("word.Application")
WD.Visible = True

yol = ThisWorkbook.Path & subfolder
Dosya = Dir(yol & "\Tohum_yetistirici_Belgesi.doc*")
Do While Dosya <> ""
WD.Application.Documents.Open yol & "\" & Dosya

    WD.Selection.Find.ClearFormatting
    WD.Selection.Find.Replacement.ClearFormatting
    With WD.Selection.Find
        .Text = Range("a1").Text
        .Replacement.Text = Range("b1").Text
        .Forward = True
        .Wrap = 1
        

        
    End With
    WD.Selection.Find.Execute Replace:=2

WD.ActiveDocument.Close True
Dosya = Dir
Loop

WD.Application.Quit

End Sub

 

[hlojan]

Sub uc()

Set WD = CreateObject("word.Application")
WD.Visible = True

yol = ThisWorkbook.Path & subfolder
Dosya = Dir(yol & "\Tohum_yetistirici_Belgesi.doc*")
Do While Dosya <> ""
WD.Application.Documents.Open yol & "\" & Dosya

[COLOR="Red"]For i = 1 To 15[/COLOR]

    WD.Selection.Find.ClearFormatting
    WD.Selection.Find.Replacement.ClearFormatting
    With WD.Selection.Find
        .Text = [COLOR="Red"]Cells(i,1)Text[/COLOR]        
        .Replacement.Text = [COLOR="Red"]Cells(i,2)Text[/COLOR]        .Forward = True
        .Wrap = 1
        

        
    End With
    WD.Selection.Find.Execute Replace:=2

[COLOR="Red"]Next i[/COLOR]

WD.ActiveDocument.Close True
Dosya = Dir
Loop

WD.Application.Quit

End Sub

 

[sametozyavuz]

hocam düzeltmelerinizi uyguladım kod çalışıyor gibi görünüyor fakat word belgesinde bir değişiklik meydana gelmiyor. eski kodu yazdığımda istediğim değişiklikler oluyor. sorun neyden kaynaklanıyor olabilir. (hata mesajı alınca Cells(i,1).Text şekilnde yazdım kodları yani nokta ekledim.)