XL 2016 Extraire si échéance dépassée

[KTM]

Bonjour chers tous
Je voudrais extraire les enregistrements pour lesquels l'échéance a excédé 90 jours selon la date en M . Merci

 

[ChTi160]

Bonsoir KTM
une version Vba (perfectible)
jean marie

 

[Phil69970]

Bonjour @KTM , le forum

Je te propose ceci
*Comme tu n'as pas rien précisé les extraire c'est vague .... pour les mettre ou ? Dans une autre feuille , les supprimer ou juste les marquer comme je l'ai fait ?

Je voudrais extraire les enregistrements

@Phil69970

 

[ChTi160]

Re
Bonsoir Philippe
après avoir vu ton Fichier je me suis rendu Compte
1° que j'ai oublié d'enlevé le MsgBox .
2° je n'ai pas fait la Bonne comparaison Lol
le Nouveau texte de la Procédure

Public Function Recup()
x = 0
With Worksheets("Ext")
Dte = IIf(IsDate(.Cells(1, 13)), CDate(.Cells(1, 13)), Date)
T = .ListObjects("TB_Gen").DataBodyRange.Value2
For Lgn = 1 To UBound(T, 1)
  If CDate(T(Lgn, 10)) + 90 < Dte Then
'Ou aussi
'  If DateDiff("d", CDate(T(Lgn, 10)), Dte, vbMonday, vbFirstFourDays) > 90 Then
  x = x + 1
    ReDim Preserve TB_Recup(10, x)
     For Col = 1 To UBound(T, 2)
       TB_Recup(Col, x) = T(Lgn, Col)
     Next Col
  End If
Next Lgn
If x = 0 Then Exit Function
.Cells(3, 13).Resize(UBound(TB_Recup, 2), UBound(TB_Recup)) = Application.Transpose(TB_Recup)
End With
Erase TB_Recup: Set T=Nothing
End Function

Bonne soirée
jean marie

 

[Phil69970]

Bonsoir Jean Marie

Désolé problème de rafraichissement de post

@Phil69970

 

[ChTi160]

Re
pas de problème !
Bonne fin de Soirée
jean marie

 

[KTM]

Bonsoir KTM
une version Vba (perfectible)
jean marie

Merci Infiniment

 

[KTM]

Bonjour @KTM , le forum

Je te propose ceci
*Comme tu n'as pas rien précisé les extraire c'est vague .... pour les mettre ou ? Dans une autre feuille , les supprimer ou juste les marquer comme je l'ai fait ?

@Phil69970

super Merci