Hola.. Tengo problemas con esta macro..

hola espero me puedas ayudar ....LUIS M.

esta es la macro:

Sub COLOREAR_DUPLI()

Application.ScreenUpdating = False
Range("D65000").End(xlUp).Offset(1, 0).Value = "final"
Range("D1").Select
Do While ActiveCell.Value <> "final"
contarsi = Application.WorksheetFunction.CountIf(Columns(4), ActiveCell)
If contarsi > 1 Then
ActiveCell.EntireRow.Interior.ColorIndex = 6
End If
ActiveCell.Offset(1, 0).Select
Loop
If contarsi = 1 Then
MsgBox "No hay datos duplicados en la data Cuadro General....", vbInformation + vbOKOnly, "Eduardo Diaz G."
End If
ActiveCell.ClearContents

End Sub

funciona todo muy bien...excepto que cuando termina de leer los datos..hasta la ultima celda llena de la columna D, no hay un contador..osea q si empezó contando los duplicados..q son dos..pareciera q se reseteara ya q no esta acumulando los datos repetitivos de dicha columna..ayudame xfa gracias..