Hallo Daniel

das Script funktioniert gut, aber es wird immer eine erste Zeile mit kopiert (siehe Screenshot) und nur bei der zweiten Zeile darunter stimmt der Wert nicht, die nächsten Zeilen sind dann alle in Ordnung.





https://www.herber.de/bbs/user/173222.xlsx


Sub test()
Dim x1 As Range
Dim x2 As Range
Dim i As Long

Application.DisplayAlerts = False
For i = 2 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(2).Delete
Next
Application.DisplayAlerts = True

With ThisWorkbook.Sheets(1)
Set x2 = .Cells(1, 3)
.UsedRange.Sort key1:=x2, order1:=xlAscending, Header:=xlYes
Do
Set x1 = x2.Offset(1, 0)
If x1.Value = "" Then Exit Do
Set x2 = x1.EntireColumn.Find(what:=Split(x1.Value, "+")(0) & "*", lookat:=xlWhole, searchdirection:=xlPrevious)
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Split(x1.Value, "+")(0)
.Rows(1).Copy ActiveSheet.Cells(1, 1)
Range(x1, x2).EntireRow.Copy ActiveSheet.Cells(2, 1)
Loop
End With

End Sub