Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [J1]) Is Nothing Then
Dim ExpirationDate, T, i, C
[A2:G10000].ClearContents
Application.ScreenUpdating = False
ExpirationDate = Int(Application.EDate(Now, [J1])) ' Date d'expiration
T = Sheets("Details").[A1].CurrentRegion ' Transfert données dans tableau
For i = 2 To UBound(T)
If T(i, 5) >= ExpirationDate Then ' Si date > date d'expiration
For C = 1 To 6: T(i, C) = "": Next C ' On vide la ligne
End If
Next i
[A1].Resize(UBound(T, 1), UBound(T, 2)) = T ' On restitue le tableau et tri sur date ascendante
[A:F].Resize(UBound(T)).Sort key1:=[E1], order1:=xlAscending, Header:=xlYes
[G1] = "Expiration"
DL = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("G2:G" & DL).Formula = "=E2-TODAY()" ' On calcul le délai dexpiration et on tri dessus
[A:G].Resize(DL).Sort key1:=[G1], order1:=xlAscending, Header:=xlYes
End If
Fin:
Application.ScreenUpdating = True
End Sub