Benzer kayıtların yeni sayfada listelenmesi

[gezmis2002]

Merhaba arkadaşlar,
Öncelikle sitede gerekli aramaları yaptığımı ve istediğim sonuca ulaşamadığım için yeni başlık açmak zorunda kaldığımı belirtmek istedim sizler bana kızmadan önce. Sorunum şudur (aslında çok basittir mutlaka ama cahilliğimi mazur görün , yardımcı olacak arkadaşlara şimdiden teşekkürler.
Ekte gönderdiğim listede aynı ad soyad kayıtlarının silinmeden ayrı bir sayfada listelenmesini istiyorum. Eğer mümkün olursa bu işi yapabileceğim farklı alternatifleri de öğrenmek isterim. Teşekkürler.

 

[hamitcan]

Aşağıdaki kodu dener misiniz?

Sub MUK()
Sheets(2).[a:c].Clear
son = [a65536].End(3).Row

For tt = 1 To son
    Cells(tt, "d") = Cells(tt, "a") & " " & Cells(tt, "b")
Next
For t = 1 To son
    say = WorksheetFunction.CountIf(Columns(4), Cells(t, 4))
    If say > 1 Then
    k = k + 1
Range(Cells(t, 1), Cells(t, 3)).Copy Sheets(2).Cells(k, 1)
    End If
Next
'Sayfa2.[a:c].Sort KEY1:=Sayfa2.[a1]'İsterseniz sıralama yaptırabilirsiniz
Columns("d").Clear
End Sub

 

[gezmis2002]

Einize sağlık çok teşekkürler, fakat ikinci sayfaya atılan mükerrer kayıtların biçimleri de bozulmasın istiyorum, yani kaynak veri hangi renkte ise o şekilde listelenebilir mi? ya da adı ve soyadı sutunlarının yanına "unvanı" isimli yeni bir stun daha eklediğimizi düşünürsek (ekteki dosyada ki gibi) mükerrer kayıtların listelendiği diğer sayfaya unvanlarına ait bilgiyide görmek istersem ne yapmalıyım, çok teşekkür ediyorum.

 

[hamitcan]

Kodu güncelledim.

 

[gezmis2002]

Sorunum çözüldü sayenizde çok teşekkür ederim.
Size zahmet olmayacaksa kodun güncellenmemiş bir önceki halini de gönderebilir misiniz, aradaki farkı anlamaya çalışacağım da..

 

[hamitcan]

Galiba aşağıdaki gibiydi

Sub MUK()
Sheets(2).[a:c].Clear
son = [a65536].End(3).Row

For tt = 1 To son
    Cells(tt, "d") = Cells(tt, "a") & " " & Cells(tt, "b")
Next
For t = 1 To son
    say = WorksheetFunction.CountIf(Columns(4), Cells(t, 4))
    If say > 1 Then
    k = k + 1
Sheets(2).Cells(k, 1) = Cells(t, 4)
    End If
Next
Sayfa2.[a:c].Sort KEY1:=Sayfa2.[a1]
Columns("d").Clear
End Sub