AW: Hallo an WernerB....
WernerB.
Hallo Kerstin,
entspricht dieses Makro jetzt Deinen Wünschen?
Sub Kerstin_Hu()
Dim sT1 As String, sT2 As String
Dim i As Long, laR As Long
Application.ScreenUpdating = False
ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
Sheets("Herkunft beides").Select
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1).Value <> Cells(i - 1, 1).Value And _
Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
With Sheets(Sheets.Count)
laR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & laR & ":F" & laR).Value = _
Range("A" & i & ":F" & i).Value
Rows(i).Delete Shift:=xlUp
End With
End If
Next i
Cells.Copy
With Sheets(Sheets.Count)
.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Range("A1:F" & laR).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
laR = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:F" & laR).Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
For i = laR To 2 Step -1
sT1 = Cells(i, 1).Text & Cells(i, 2).Text
sT2 = Cells(i - 1, 1).Text & Cells(i - 1, 2).Text
If sT1 = sT2 Then
Cells(i - 1, 1).Interior.ColorIndex = 46
Rows(i).Delete Shift:=xlUp
ElseIf Cells(i, 1).Interior.ColorIndex = 46 Then
Rows(i).Delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub
Gruß
WernerB.
P.S.: Im Erfolgsfall bin ich mit einem kleinen "Dankeschön" zufrieden, ansonsten bitte ich um eine entsprechende Rückmeldung.
Leider gibt es auch viele Zeitgenossen zu denen Du gewiss nicht gehörst die die hier oft sehr zeitaufwändig erarbeiteten Lösungsvorschläge kommentarlos konsumieren. So weiß der Antworter nicht, ob er mal wieder für den Papierkorb gearbeitet hat oder ob sein Vorschlag zu gebrauchen war und solche Erlebnisse sind für den Antworter doch mehr als frustierend.