Birden fazla aynı hesabı tek hesap olarak aktarmak

[haso_excel]

Merhaba arkadaş ekdeki dosyada da göreceğiniz üzere sheet1 deki D ve E kolonlarında bazen tek,bazen iki, bazende daha fazla müşteri kodu var. Amacım sheet2 ye onların tek hesap ve isim olarak aktarmak için bir koda ihtiyacım var.

 

[dEdE]

Merhaba,
İstediğiniz böyle bir kod mu acaba?

Sub aktar()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")

For i = 2 To s1.[D65536].End(3).Row
    If WorksheetFunction.CountIf(Range(s1.Cells(1, 4), s1.Cells(i - 1, 4)), s1.Cells(i, 4)) <= 0 Then
        ssA = IIf(s2.Cells(1, 1) = "", 1, s2.[A65536].End(3).Row + 1)
        s2.Cells(ssA, 1) = s1.Cells(i, 4)
        s2.Cells(ssA, 2) = s1.Cells(i, 5)
    End If
Next
End Sub

 

[haso_excel]

Teşekkür ederim üstadım tam istedğim gibi eline sağlık

 

[dEdE]

Rica ederim.
Güle güle kullanın.

 

[cantemur]

çok teşekkür ederim ellerinize sağlık evet istediğim buydu zaten

hoşçakalın görüşmek üzere