Aynı değerde olan verilerin diğer sayfaya aktarılması

[kontto]

İyi günler arkadaşlar, yardımlarınıza ihtiyacım var yardım ederseniz sevinirim. Şöyle ki; ekte gönderdiğim dosyada "VERI" sayfasında farklı malzeme kodlarından oluşan bir listem var. Benim sizden istediğim yardım. "VERI" sayfasına kaydedilen farklı kodlarının herhangi birisini aşağıdaki MISSON sayfasında ki G16 satırına yazdığım zaman aynı koddan oluşan tüm bilgilerin "BILGI" sayfasına aktarılması. Yardımlarınız için şimdiden teşekkür ederim. Dosyam ektedir.

 

[Ömer]

Merhabai

MISSON sayfası kod bölümüne kopyalayın. G16 hücresine veri girince kod çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Sv As Worksheet, Sb As Worksheet, sat As Long, c As Range, Adr As Variant
 
    If Intersect(Target, Range("G16")) Is Nothing Then Exit Sub
 
    Set Sv = Sheets("VERI")
    Set Sb = Sheets("BILGI")
    
    Sb.Rows("2:" & Rows.Count).Clear
 
    sat = 2
    With Sv.Range("A:A")
        Set c = .Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Sv.Range("A" & c.Row & ":I" & c.Row).Copy Sb.Cells(sat, "A")
                sat = sat + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
End Sub

.

 

[kontto]

Ömer bey çok teşekkür ederim ellerinize sağlık.