Çözüldü Düşey olarak kayıt tekrarı olan listeyi aynı sayfaya sadeleştirerek yatay olarak sıralamak istiyorum

[hamza2011]

Merhabalar;

Ek' li dosyada paylaştığım örnekte de belirttiğim gibi; düşey olarak tekrar eden kayıtlarımı isimlerini sadeleştirerek kodları ile birlikte yatay olarak sıralamak istiyorum.

Konu hakkında yardım eder misiniz.

 

[çıtır]

Dosyanız.

 

[hamza2011]

Hocam çok teşekkür ederim.. Harika oldu

 

[çıtır]

Hocam çok teşekkür ederim.. Harika oldu

Rica ederim.Dönüş yaptığınız için teşekkür ederim.

 

[hamza2011]

Rica ederim.Dönüş yaptığınız için teşekkür ederim.

Formüle bakar mısınız, dönüş yapmasam çarpılırdım herhalde. Valla o derece şahane, işimi çok kolaylaştırdı.

 

[çıtır]

Makro ile çözüm

Sub Sütuntaşı()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
Application.ScreenUpdating = False
son1 = s1.Cells(65336, "F").End(3).Row
son = s1.Cells(65336, "B").End(3).Row + 1
t2 = s1.UsedRange.Columns.Count
s1.Range(Cells(2, 6), Cells(son1, t2 + 10)).Clear
s1.Range("B2:B" & son).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1"), Unique:=True
    s1.Range("F1").Select
    Selection.Clear
son2 = s1.Cells(65336, "F").End(3).Row
For satır = 2 To son
If s1.Range("B" & satır) <> "" Then
Var = WorksheetFunction.Match(s1.Range("B" & satır), s1.Range("F2:F" & son2), 0) + 1
sonS = Cells(Var, Columns.Count).End(1).Column + 1
s1.Cells(Var, sonS) = s1.Cells(satır, 3)
s1.Cells(Var, sonS).Borders.LineStyle = xlContinuous
End If
Next satır
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "BİLGİNİZE!"
End Sub

 

[hamza2011]

Hocam bu daha fena oldu. Ateş ediyor resmen

Elinize, bilginize sağlık. Tekrar tekrar teşekkürler..