Digamos que começamos com:
eexecutamosestamacrocurta:
SubRowKiller101()DimrKillAsRange,rAsRange,wfAsWorksheetFunctionDimrBigAsRangeSetrBig=Intersect(Range("A:A"), ActiveSheet.UsedRange)
Set rKill = Nothing
Set wf = Application.WorksheetFunction
For Each r In rBig
If wf.CountIf(rBig, r.Value) > 3 Then
If rKill Is Nothing Then
Set rKill = r
Else
Set rKill = Union(rKill, r)
End If
End If
Next r
If rKill Is Nothing Then Exit Sub
rKill.EntireRow.Delete
End Sub
Recebemos: