Sayfaya döngüsel veri alma

[memduh]

Arkadaşlar ekte dönderdiğim dosyada sorunum mevcut. yardım edeseniz sevinirim. saygılar

 

[Orion1]

Dosyanız ekte.

Sub al()
Dim hcr As Range, s2 As Worksheet, k As Range
Sheets("Sayfa1").Select
Set s2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
For Each hcr In Range("B1:B" & Cells(65536, "B").End(xlUp).Row)
    Set k = s2.Range("B:B").Find(hcr.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        hcr.Offset(0, 1).Value = k.Offset(0, 2).Value
    End If
Next hcr
Set s2 = Nothing
Set k = Nothing
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır.."
End Sub