Alt Alta Gelen Tabloyu Yan Yana Dizme

[tiretwien]

arkadaşlar merhaba,
aşagıdaki linkte elimdeki tabloyu ornek olarak gosterdim.
istedigim alt alta aynı isimde olan verileri renkleri bozulmadan yan yana getirmek.
tablodaki kişiler alt alta 1kerede gelebilir 10 kerede gelebilir.
tablo örnektir isimler ve veriler satırlarca uzayabilir.
nasıl yapabiliriz ? yardımcı olabilir misiniz ?

Alt Alta Gelen Tabloyu Yan Yana Dizme

Sayfa1 ahmet,70,istediğim tablo ahmet,110,ahmet,70,110,200,237,308,457 ahmet,200,hasan,15,20,35,49 ahmet,237,ali,60,258 ahmet,308,murat,0 ahmet,457,samet,55,70,79,100 hasan,15 hasan,20 hasan,35 hasan,49 ali,60 ali,258 ali,300 murat,0 samet,55 samet,70 samet,79 samet,100

docs.google.com

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir Modul'e kopyalayıp çalıştırınız.

E sütunundan itibaren listelenir.

Kodlar A sütunundaki verileri sıralar, siz istemezseniz o sıralamayı kaldırabilirsiniz.

Sub YanYana()

    Dim i   As Long, _
        j   As Long, _
        k   As Integer, _
        c   As Range
    
    Application.ScreenUpdating = False
    
    Range("E1").CurrentRegion.ClearContents
    
    j = Cells(Rows.Count, "A").End(3).Row
    
    Range("A1:A" & j).Copy
    Range("E1").PasteSpecial Paste:=xlPasteValues
    
    Range("E1:E" & j).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("E1:E" & Cells(Rows.Count, "E").End(3).Row).Sort Key1:=[E1]

    For i = 1 To j
    
        Set c = Range("E:E").Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
        k = Cells(c.Row, Columns.Count).End(1).Column + 1
        Cells(c.Row, k) = Cells(i, "B")
        With Cells(c.Row, k)
            .Font.Color = Cells(i, "B").Font.Color
            .Interior.ColorIndex = Cells(i, "B").Interior.ColorIndex
            .Font.Bold = Cells(i, "B").Font.Bold
            .Font.Italic = Cells(i, "B").Font.Italic
            .Font.Name = Cells(i, "B").Font.Name
            .Font.Size = Cells(i, "B").Font.Size
        End With
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamam....."
    
End Sub

 

[tiretwien]

Merhaba @Necdet Bey
elinize sağlık cok güzel olmuş
fakat sonuç tablosunda renkler siyaha dönmüş. ana tablodaki gibi kırmızı ve mor renkler korunabilir mi ?

 

[Necdet]

Merhaba,

Kodlar yenilendi. Deneyiniz.

 

[tiretwien]

@Necdet Bey cok teşekkür ederim.
Elinize emeğine sağlık
Harika çalışıyor