Hallo, kann mir jemand die folgende Sub umbauen, dass diese die
doppelten von oben nach unten löscht/leert?
Sub Gleiche_Loeschen_SpalteA_Protokoll_Feierabend()
'Range("D1").Value = "Text"
Sheets("Protokoll").Activate
Dim i As Long
Dim lngLastR As Long
lngLastR = Cells(Rows.Count, "A").End(xlUp).Row + 1
'Zellinhalte in Spalte F durch "" = Leerzelle ersetzen
Do
i = i + 1
Range(Cells(i + 1, "A"), Cells(lngLastR, "A")).Replace _
what:=Cells(i, "A").Value, replacement:="", lookat:=xlWhole
Loop While WorksheetFunction.CountIf(Range(Cells(i + 1, "A"),
Cells(lngLastR, "A")), "") < (lngLastR - i)
'Zeilen löschen, die Leerezellen in Spalte F haben:
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cells(1, 1) = Range("A65536").End(xlUp).Row
Sheets("Hauptseite").Activate
End Sub
LG Sweni