Public Sub Doppelte_raus()
Dim loLetzte As Long, loSpalte As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, "R").End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
With .Range(.Cells(2, loSpalte), .Cells(loLetzte, loSpalte))
.FormulaLocal = "=WENN(UND(ZÄHLENWENN($Q2:$Q" & loLetzte & ";$Q2)>1;$R2=""J"");0;ZEILE())"
.Value = .Value
End With
.Cells(1, loSpalte) = 0
.Range(.Cells(1, "A"), .Cells(loLetzte, loSpalte)).RemoveDuplicates Columns:=loSpalte, Header:=xlNo
.Columns(loSpalte).ClearContents
End With
End Sub