Aynı değeri bulup yan yana yazma

[cetnkaya]

Selamın aleyküm
Arkadaşlar aynı değeri bulup yan yana yazdırmak istiyorum ekte açıklama mevcut teşekkür ederim

 

[ÖmerFaruk]

Boş bir modüle ekleyip çalıştırabilirsiniz.

Sub Lotyaz()
    Dim Bul As Range
    Set Sh1 = Worksheets("Ürün")
    Set Sh2 = Worksheets("Veri")
    If Sh1.Range("A2") = "" Or Sh1.Range("B2") = "" Then
        MsgBox "Eksik Veri"
        Exit Sub
    End If
    Set Bul = Sh2.Range("A:A").Find(Sh1.Range("A2"), , xlValues, xlWhole)
    If Not Bul Is Nothing Then
        Do Until Bul.Offset(0, 1) = ""
        Set Bul = Bul.Offset(, 1)
        Loop
        Bul.Offset(, 1) = Sh1.Range("B2")
    Else
        MsgBox Range("A2") & " ürünü bulunamadı"
    End If
End Sub

 

[cetnkaya]

Sub Lotyaz()
Dim Bul As Range
Set Sh1 = Worksheets("Ürün")
Set Sh2 = Worksheets("Veri")
If Sh1.Range("A2") = "" Or Sh1.Range("B2") = "" Then
MsgBox "Eksik Veri"
Exit Sub
End If
Set Bul = Sh2.Range("A:A").Find(Sh1.Range("A2"), , xlValues, xlWhole)
If Not Bul Is Nothing Then
Bul.End(xlToRight).Offset(, 1) = Sh1.Range("B2")
Else
MsgBox Range("A2") & " ürünü bulunamadı"
End If
End Sub

Merhaba ömerfaruk yanıtın için teşekkür ederim almış olduğum hatayı renklendirdim dosyası ekte

 

[cetnkaya]

Konu günceldir yardım rica ediyorum

 

[ÖmerFaruk]

Önceki kodu revize ettim.

 

[cetnkaya]

Ömerfaruk bey teşekkür ederim sorunum çözüldü .