VBA' da Düşeyara formülü 2

[bebar]

Merhaba;

İşimin gereği sürekli excel kullanmak durumundayım fakat bazı durumlarda excel formüllerinin yeterli olmadığı durumlarla karşı karşıya kalıyorum, hem kendimi geliştirmek hemde daha verimli olmak adına vba kod yapısını öğrenme ihtiyacını hissettim ve son 1 haftadır yoğun bir şekilde çalışıyorum (videolar , kitaplar,vs) ve daha çok emek vermem gerektiğinin farkındayım.
Ekteki dosyada örnek uygulamalar üzerinden oluşturduğum basit bir düşeyara çalışmam bulunuyor( makro gerektirmeden yapılabir farkındayım fakat kod ile nasıl yapılabileceğini merak ediyorum), yazdığım kodlar aşağıdaki gibidir ama hata veriyor, nerede hata yaptığımı bildirirseniz sevinirim.

Sub duşeyara()
Set s1 = Sheets("veri")
Set s2 = Sheets("şablon")
son = s1.Cells(65536, 2).And(xlUp).Row
son1 = s2.Cells(65536, 2).And(xlUp).Row
alan = "a20:d" & son

For i = 20 To son
If s2.Cells(i, 20) = "" Then
s2.Cells(i, 20) = Application.Worksheetsfunction.VLookup(s2.Cells(i, 1), s1.Range(alan), 4, 0)
End If
Next
End Sub

 

[vardar07]

Sizin kodlar ile karşılaştırınız.

Sub duşeyara()
Set s1 = Sheets("veri")
Set s2 = Sheets("şablon")
son = s1.Cells(65536, 2).End(xlUp).Row
son1 = s2.Cells(65536, 2).End(xlUp).Row
For i = 3 To son
If s2.Cells(i, 1) <> "" Then
s2.Cells(i, 2) = Application.WorksheetFunction.VLookup(s2.Cells(i, 1), s1.Range("A3:B" & son), 2, 0)
End If
Next
End Sub

 

[bebar]

teşekkür ederim

 

[Orion1]

Alternatif.

Sub ara_bul59()
Dim k As Range, sonsat1 As Long, sonsat2 As Long, sh As Worksheet
Dim i As Long
Sheets("şablon").Select
Set sh = Sheets("veri")
sonsat1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = Cells(Rows.Count, "A").End(xlUp).Row
Range("B3:B" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For i = 3 To sonsat1
    Set k = sh.Range("A3:A" & sonsat1).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Cells(i, "B").Value = k.Offset(0, 1).Value
        Set k = Nothing
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub