Tietojen lajittelu - identtiset samalle riville

Koetin löytää netistä koodia tuohon ongelmaan (varmaan helpoin tapa ratkaista ongelma), muttei oikein löytynyt. Omat taidot heikossa hapessa.
Kaavalla onnistuisi näin. Lisää A ja B-sarakkeiden väliin 2 uutta saraketta.
B1=JOSVIRHE(INDEKSI($D$1:$D$6;VASTINE(A1;$D$1:$D$6;0));"")
C1=JOSVIRHE(INDEKSI($E$1:$E$6;VASTINE(A1;$E$1:$E$6;0));"")
Muuta solualueet sinulle oikeiksi.
Vedä kaavat niin alas kuin tarvitsee. "Uusille" B ja C-sarakkeille jää A-saraketta vastaava nimi jos sellainen löytyy "vanhasta", muuten jää tyhjäksi.
Kopioi B ja C-sarakkeet ja Liitä Määräten (vain arvot) samoille paikoille takaisin ja tyhjennä/poista D ja E-sarakkeet.

tavalliseen moduuliin...

Sub Kopioi()
Dim Dict As Object
Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim solu As Variant
Set Dict = CreateObject("scripting.dictionary")
'muuta listojen solualue sopivaksi
a = Range("A1:C100").Value
For Each solu In a
If Not solu = "" Then
If Dict.Exists(solu) Then
Dict.Item(solu) = Dict.Item(solu) 1
Else
Dict.Add solu, 1
End If
End If
Next
b = Dict.Items
c = Dict.Keys
'muuta tulostusalue sopivaksi
Range("K1:M100") = ""
Range("K1").Select
For i = 0 To UBound(b)
ActiveCell.Resize(1, b(i)) = c(i)
ActiveCell.Offset(1, 0).Select
Next
ActiveSheet.Sort.SortFields.Clear
' muuta listojen alimman rivin rivinumero tähän
ActiveSheet.Sort.SortFields.Add Key:=Range("K1:K100"), Order:=xlAscending
With ActiveSheet.Sort
'muuta lajiteltava solualue sopiaksi
.SetRange Range("K1:M100")
.Apply
End With
End Sub

Keep EXCELing
@Kunde

Tarkkaan ottaen tämä ei järjestä, mutta lopputulos on sama.

Sub järjestä()
   v = Cells(65536, "A").End(xlUp).Row
   Alue2 = Range("B1:C" & v).Value
   Range("B1:C" & v).Clear
   r = 1
   Do Until Cells(r, "A") = ""
      i = 0
      For Each solu In Alue2
         If solu = Cells(r, "A") Then
            i = i 1
         End If
      Next
      For c = 1 To i
         Cells(r, 1 c) = Cells(r, "A")
      Next c
      r = r 1
   Loop
End Sub

niin lopputulos sama ilman lajittelua, mutta toinen alkaa hyytyyn nopeastikin kun rivien ja sarakkeiden määrä kasvaa ... ;-)

Keep EXCEling
@Kunde