[RESOLU] Macro : suppression des doublons avec une condition de date

Private Sub Workbook_Open()
Sheets("V1").Select
ActiveSheet.Range("T2").Value = Environ("UserName")
End Sub

Option Explicit

Sub Nettoyer()
Dim dico As Object, a, i As Long, x As Range
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Consolidation").Range("a1").CurrentRegion
        .Offset(2).Resize(.Rows.Count - 2).Interior.ColorIndex = xlNone
        a = .Value
        For i = 3 To UBound(a, 1)
            If Not dico.exists(a(i, 2)) Then
                dico(a(i, 2)) = VBA.Array(a(i, 1), i)
            Else
                If a(i, 1) >= dico(a(i, 2))(0) Then
                    dico(a(i, 2)) = VBA.Array(a(i, 1), i)
                End If
            End If
        Next
        For i = 3 To UBound(a, 1)
            If dico.exists(a(i, 2)) Then
                If a(i, 1) <= dico(a(i, 2))(0) And i <> dico(a(i, 2))(1) Then
                    If x Is Nothing Then
                        Set x = .Rows(i)
                    Else
                        Set x = Union(x, .Rows(i))
                    End If
                End If
            End If
        Next
    End With
    If Not x Is Nothing Then
        x.Interior.ColorIndex = 42    'surligne
     Else
        MsgBox "Aucune ligne à supprimer"
    End If
    'If Not x Is Nothing Then x.EntireRow.Delete 'supprime
    Set x = Nothing
End Sub

Sub es()
With Range("a3:ac" & Cells(Rows.Count, 1).End(3).Row)
.Sort Key1:=Range("a3"), Order1:=xlDescending, Header:=xlYes
.RemoveDuplicates Columns:=Array(3)
End With
End Sub