Makro ile Vlook kullanarak kopyala yapistir yardim

[byvolkan]

Iyi gunler
Bir konuda yardimlarinizi bekliyorum.

Sayfa 1 de A sutununda sayilardan olusan bir listem var. B sutununda ise her sayiya karsilik gelen isimlerden olusan bir listem var.
Sayfa 2 de A sutununda sayilardan olusan bir listem var. B sutununda ise her sayiya karsilik gelen bir tarihlerden olusan bir listem var.
Benim sorum su :
Sayfa 1 de A5 hucresindeki sayinin karsiligina denk gelen B5 hucresindeki isimi bir makro yardimi ile sayfa 2 deki A sutununda bulunan ayni sayinin oldugu satirin C sutununa kopyalamak.

Yardimlariniz için simdiden çok tesekkurler

 

[AdemCan]

İyi günler.

Aşağıdaki kodlar ile istediğinizi yapabilirsiniz.

Set s1 = Sheets("Sayfa1"): Set s2 = Sheets("Sayfa2")
Satırındaki Sayfa1 ve Sayfa2 isimleri sekme üzerindeki isimlerdir.

İkinci satırdan itibaren karşılaştırma yapar, farklı bir satırdan başlatmak isteseniz For x = 2 To... ve For y = 2 To... satırlarındaki 2 değerini değiştiriniz.

Sub kopyala()
Dim s1 As Worksheet, s2 As Worksheet

Set s1 = Sheets("Sayfa1"): Set s2 = Sheets("Sayfa2")

For x = 2 To s2.Cells(Rows.Count, 1).End(3).Row
    For y = 2 To s1.Cells(Rows.Count, 1).End(3).Row
        If s2.Cells(x, 1).Value = s1.Cells(y, 1).Value Then
            s2.Cells(x, 3).Value = s1.Cells(y, 2).Value
        End If
    Next y
Next x

Set s1 = Nothing: Set s2 = Nothing
End Sub

 

[byvolkan]

Sayin efsane yardimlariniz için çok tesekkurler.
Bu formulde birinci sayfamizdaki tum sayi listesini degilde sadece A5 hucresindeki yazan sayinin degerini sayfa 2 de aratmak ve karsiligi olan b sutunundaki degeri kopyalamak istersek k ne yapmamiz gerekir?

Bu yolladiginiz formulde bir baska çalismam için çok isime yaradi bana baska bir fikir verdi. yalniz A5 hucresi benim için çok onemli kullandigim belgede butun degerler A5 hucresine yazilan sayiya gore çalisiyor.
Cok tesekkkurler.

 

[AdemCan]

Rica ederim.

Sayfa1 A5 hücresindeki değeri Sayfa2 içinde arayıp, Sayfa1 B5 hücresindeki değeri Sayfa2 C sütununa yazmak için,
1. Örnek

Sub kopyala()
Dim s1 As Worksheet, s2 As Worksheet

Set s1 = Sheets("Sayfa1"): Set s2 = Sheets("Sayfa2")

For x = 2 To s2.Cells(Rows.Count, 1).End(3).Row
        If s2.Cells(x, 1).Value = s1.Range("A5").Value Then
            s2.Cells(x, 3).Value = s1.Range("B5").Value
            Exit For
        End If
Next x

Set s1 = Nothing: Set s2 = Nothing
End Sub

2.Örnek

Sub kopyala2()
Dim s1 As Worksheet, s2 As Worksheet

Set s1 = Sheets("Sayfa1"): Set s2 = Sheets("Sayfa2")
sons2 = s2.Cells(Rows.Count, 1).End(3).Row

If WorksheetFunction.CountIf(s2.Range("A2:A" & sons2), s1.Range("A5").Value) > 0 Then
    bul = s2.Range("A2:A" & sons2).Find(s1.Range("A5").Value).Row
    s2.Range("A" & bul).Offset(0, 2).Value = s1.Range("B5").Value
End If

Set s1 = Nothing: Set s2 = Nothing
End Sub

 

[byvolkan]

Sayin efsane
Isyerimdeki yogunluktan dolayi biraz geç gordum mesajlarinizi.
Yardimlariniz için çok tesekkur ederim.