Aynı Dosyadaki Bilgilerin eş ise kopyalama

[efem67]

Değerli Hocalarım ve Üstadlar;
Aynı excel dosyası içerinde SayfaANA deki C5 İLE C 180 Arasındaki ad soyad bilgisi
Diğer SayfaLISTE deki yazdığım her hangi bir alana Ad ve Soyadı yazdığımda
eşleşiyor ise SayfaANA daki D, E, F ve G hücresindeki bilgileri kopyalasın..
Saygılarımla;

 

[Muzaffer Ali]

Merhaba.

LISTE adlı sayfanın kod kısmına aşağıdaki kodları kopyalayın.
Kodlar otomatik çalışacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    If Target.Cells.Count = 1 Then
        If Target <> "" Then Set Bul = Worksheets("ANA").Range("C5:C180").Find(what:=Target, lookat:=xlWhole)
        If Not Bul Is Nothing Then
            Application.EnableEvents = False
            Bul.Offset(0, 1).Resize(1, 5).Copy Target.Offset(0, 1)
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[efem67]

Teşekkürler Hocam;
Peki Diğer sayfalar da da geçerli olması için Her sayfa bu kodları eklemem mi gerekecek.
Yoksa Hangi sayfada işlem yapılırsa yapılsın geçerli olma durumu olabiliyormu?
Saygılarımla;

 

[Muzaffer Ali]

Önceki kodu silin.
Aşağıdaki kodu BuÇalışmaKitabı adlı kod sayfasına kopyalayın.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Bul As Range
    Dim Sayfalar As Variant

    Sayfalar = Array("Sayfa1", "Sayfa2", "Sayfa3")

    If UBound(Filter(Sayfalar, Sh.Name)) >= 0 And Target.Cells.Count = 1 Then
        If Target <> "" Then Set Bul = Worksheets("ANA").Range("C5:C180").Find(what:=Target, lookat:=xlWhole)
        If Not Bul Is Nothing Then
            Application.EnableEvents = False
            Bul.Offset(0, 1).Resize(1, 5).Copy Target.Offset(0, 1)
            Application.EnableEvents = True
        End If
    End If
End Sub

Sayfalar = Array("Sayfa1", "Sayfa2", "Sayfa3") Buradaki sayfa isimleri yerine kodların çalışmasını istediğiniz sayfa adlarını yazın.

 

[efem67]

Değerli Hocam son gönderdiğiniz kod çalışmadı...

 

[Muzaffer Ali]

Kodu dosyanıza ekledikten sonra dosyanızı paylaşırsanız kontrol edelim.