Ara, ilgili veriyi bul, Listele

[reflargon]

Merhaba

Sabahtan beri üzerinde çalışıp yapamadığım bir sorgu var. Yardımcı olabilirseniz ustalarım çok sevinirim.

Örnekte daha açık anlatmaya çalıştım. İstenen olay "A2" hücresindeki değerin "veriler" isimli sayfadan aranıp mütakibindeki (yan sütünlardaki) değerlerin ana sayfada satır satır listeletebilmek..

Teşekkürler..

 

[Necdet]

Merhaba,

Aşağıdaki kodları "ARABUL" sayfasının kod bölümüne kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A2]) Is Nothing Then Exit Sub
    Dim Bul As Range, _
        Adr As String, _
        Sat As Long, _
        sv  As Worksheet
    Set sv = Sheets("VERİLER")
 
    Application.ScreenUpdating = False
    Sat = Cells(Rows.Count, "a").End(3).Row
    If Sat < 5 Then Sat = 5
    Range("A5:C" & Sat).ClearContents
 
    Sat = 4
 
    With sv.Range("A:A")
        Set Bul = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Adr = Bul.Address
            Do
                Sat = Sat + 1
                Cells(Sat, "A") = sv.Cells(Bul.Row, "B")
                Cells(Sat, "B") = sv.Cells(Bul.Row, "C")
                Cells(Sat, "C") = sv.Cells(Bul.Row, "D")
                Set Bul = .FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
    If Sat - 4 = 0 Then
        MsgBox "AKTARILACAK BİLGİ BULUNMAMIŞTIR", vbCritical + vbInformation
    Else
        MsgBox Sat - 4 & " ADET KAYIT AKTARILMIŞTIR", vbInformation
    End If
 
End Sub

 

[reflargon]

Vaoovv : ) Bu kodlar beni bir parça aşıyor. Yardımınız için çok teşekkürler. Tam istediğim gibi çalışıyor. Ekstralar için ayrıca teşekkür ederim.