Macro para eliminar duplicados si se cumple la condición

[Hola 

te paso la macro

Sub eliminar()
'[Por Adriel Ortiz
Set h = Sheets("Hoja1")
'
u = h.Range("O" & Rows.Count).End(xlUp).Row
For i = u To 2 Step -1
    If Cells(i, "O") = "D" Then
        h.Rows(i).Delete xlShiftUp
    End If
Next i
MsgBox "Fin"
End Sub

Valora la respuesta para finalizar

Te anexo la macro

Sub Eliminar_Duplicado()
'Por.Dante Amor
    For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(Columns("A"), Cells(i, "A")) > 1 And Cells(i, "O") = "D" Then
            Rows(i).Delete
        End If
    Next
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Prueba este código a ver que tal te va:

Sub Macro3()
    ActiveWorkbook.Worksheets("Hoja1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Hoja1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Hoja1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    Do
    If ActiveCell.Offset(1, 0).Value = ActiveCell.Value Then
    If ActiveCell.Offset(0, 14).Value = "A" Then
    ActiveCell.Offset(1, 0).EntireRow.Delete
    Else
    Selection.EntireRow.Delete
    End If
    End If
    ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Value = ""
End Sub