Farklı satırlardaki detayları birleştirmek

[bosweer]

Merbaha arkadaşlar,

Kişilerin, adres telefon mail gibi detaylarının bulunduğu bir listemiz var.
Ancak aynı kişinin detayları farklı satırlarda. Aynı kişinin detaylarını nasıl birleştirebilirim.

Örnek dosya ektedir.

İlginize teşekkür ederim.

 

[Ömer]

Merhaba,

Module kopyalayıp çalıştırın.

Sub OzetBirlestir()
 
    Dim d As Object, i As Long, j As Byte, deg, s(), a1
    Dim sat As Byte, sut As Byte
 
    Application.ScreenUpdating = False
    Range("G:K").ClearContents
 
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            ReDim s(1 To 5)
            For j = 1 To 5
                s(j) = Cells(i, j)
            Next j
            d.Add deg, s
        Else
            s = d.Item(deg)
            For j = 3 To 5
                If Cells(i, j) <> "" Then
                    s(j) = Cells(i, j)
                End If
            Next j
            d.Item(deg) = s
        End If
    Next i
 
    a1 = d.items: sat = 1: sut = 6
    For i = 0 To d.Count - 1
        s = a1(i)
        For j = 1 To 5
            Cells(i + sat, j + sut) = s(j)
        Next j
    Next i
 
    Cells.EntireColumn.AutoFit
 
End Sub

.

 

[bosweer]

Teşekkür ederim Ömer Bey.

Emeğinize sağlık.