Sayfa2 de eşleşenleri Sayfa1'e kopyalama

[steppe]

İyi Akşamlar Arkadaşlar,
Sayfa1 ile Sayfa2 de eşleşen veriler varsa (ikişer sütunlarını karşılaştırarak)
Sayfa2 deki eşleşen satırdaki bilgileri Sayfa1 de eşleşen ilgili satıra kopyalama.
Detaylı açıklama örnek dosyada mevcut.Yardımlarınız için şimdiden teşekkürler.

 

[Orion1]

Dosyanız ektedir.

Sub veri_aktar()
Dim i As Long, sat1 As Long, sat2 As Long, k As Range
Sayfa1.Select
Sayfa1.Range("C2:C" & Cells(Rows.Count, "B").End(xlUp).Row).Clear
Sayfa1.Range("C2:C" & Rows.Count & ",E2:E" & Rows.Count).Clear
Application.ScreenUpdating = False
sat1 = Sayfa1.Cells(Rows.Count, "B").End(xlUp).Row
sat2 = Sayfa2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sat1
    If Cells(i, "B").Value <> "" Then
        Set k = Sayfa2.Range("A1:A" & sat2).Find(Cells(i, "B").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
        Do
            If Cells(i, "D").Value = k.Offset(0, 2).Value Then
                k.Offset(0, 1).Copy Sayfa1.Cells(i, "C")
                k.Offset(0, 3).Copy Sayfa1.Cells(i, "E")
                Application.CutCopyMode = False
                Exit Do
            End If
            Set k = Sayfa2.Range("A1:A" & sat2).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
        End If
    End If
Next i
Sayfa1.Range("C2:E" & sat1).Font.Size = 12
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
        vbOKOnly + vbInformation, Application.UserName
End Sub

 

[steppe]

Orion1 Hocam,
Yardımlarınız için çok teşekkür ederim.

 

[steppe]

Merhaba Arkadaşlar,
Yukarıdaki kodlar gayet güzel çalışıyor. Orion Hocama çok teşekkür ederim.
Bugün epeyce üzerinde çalıştım fakat bir türlü beceremedim. Eğer şehir telefon eşleşiyorsa Sayfa1 isimleri nasıl çekebilirim.
Yardımlarınız için şimdiden teşekkür ederim.