Makro ile çalışma sayfasında değer aratıp yanındaki değeri sayfaya kopyalamak

[airjordan2010]

Merhabalar,
Açık olan bir çalışma sayfasındaki A1 hücresindeki değeri başkabir çalışmasayfasına aratıp yanındaki değeri A2 hücresine yapıştırmak istiyorum.
Bu işlemi makro ile nasıl yapabilirim
Teşekkürler

Ekteki dosyalar
1- Çalışma sayfam
2- Sevk yerleri ( bu dosya içinde B kolonunda arama yapacak ve A kolonunda yanına düşen değerini Çalışma sayfamdaki A2 hücresine getirecek)

 

[Orion1]

Her 2 dosyanında ayni klasör içinde olması lazım.

Sub dis_dosyadan_veri_al()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
'Tools==> refernceden Microsoft Activex Data Object Library seçildi
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Range("C1").Value = ""
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\Sevk Yerleri.xls;extended properties=""Excel 8.0;hdr=yes"""
rs.Open "Select * from [Sevk_Yerleri_Raporu_Form_Kodu$] where Sevk_Yeri='" & Range("A1").Value & "';", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then
    rs.MoveFirst
    Range("C1").Value = rs(0).Value
    Else
    MsgBox Range("A1").Value & " Bulunamdı", vbCritical, "UYARI"
    Range("A1").Select
End If
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub