Hallo Günther,
die Mühe hatte ich mir auch schon gemacht.
Ich will gerne ohne Hilfsspalten arbeiten weil ein anderen Makro auf die Daten zugreift, daher fallen der 1. und 3. Link von dir weg.
Der 2 Link sieht hilfreich aus (den hatte ich tatsächlich vorher nicht gegoogelt), da müsste ich mal schauen wie ich das auf mehrere Spalten anpasse und ob es dann funktioniert, das scheint zum Ende hin ja außerhalb des Threads gelöst worden zu sein.
Beste Grüße
Leo
Mit dem Code aus dem 2. Link, laufe ich in den gleichen Fehler wie der Kollege im Thread beschrieben hat.
Code:
Sub Daten_sortieren()
Dim Aktiver_Blattname As String, Wiederholungen_Zeile As Long, _
Wiederholungen_Spalte As Integer, Wiederholungen_Zeile_Tab2 As Long
Application.ScreenUpdating = False
Aktiver_Blattname = ActiveSheet.Name
With Worksheets.Add
.Name = "Hilfsblatt"
End With
For Wiederholungen_Zeile = 1 To Sheets(Aktiver_Blattname).Range("A65536").End(xlUp).Row
Sheets("Hilfsblatt").Cells.ClearContents
Sheets("Hilfsblatt").Range("A1") = Sheets(Aktiver_Blattname).Cells(Wiederholungen_Zeile, 1)
Sheets("Hilfsblatt").Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, TrailingMinusNumbers:=True
For Wiederholungen_Spalte = 2 To Sheets("Hilfsblatt").Range("IV1").End(xlToLeft).Column
Sheets("Hilfsblatt").Cells(Sheets("Hilfsblatt").Range("A65536").End(xlUp).Offset(1, 0).Row, 1) = _
Sheets("Hilfsblatt").Cells(1, Wiederholungen_Spalte)
Sheets("Hilfsblatt").Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlDescending
Sheets("Hilfsblatt").Range("B1").ClearContents
For Wiederholungen_Zeile_Tab2 = 1 To Sheets("Hilfsblatt").Range("A65536").End(xlUp).Row
Sheets("Hilfsblatt").Range("B1") = Sheets("Hilfsblatt").Cells(Wiederholungen_Zeile_Tab2, 1) _
& " " & Sheets("Hilfsblatt").Range("B1")
Sheets(Aktiver_Blattname).Cells(Wiederholungen_Zeile, 1) = Sheets("Hilfsblatt").Range("B1")
Next
Next
Next
Sheets(Aktiver_Blattname).Activate
Application.DisplayAlerts = False
Sheets("Hilfsblatt").Delete
Application.DisplayAlerts = True
End Sub