XL 2016 souci macro

[eastwick]

Bonjour à toutes et tous,
Je ne parviens pas à faire aboutir ma macro au résultat souhaité. J'aimerais ne conserver que les lignes ou la date d'arrivée de facture est supérieure ou égale au 01/11/2025 sauf pour 3 fournisseurs (colonne A) : pour les n°122,146 et 7384, sans doute d'autres par la suite.
Je souhaite vraiment une macro pour pouvoir la poursuivre ensuite avec de la mise en forme, enfin des actions simples.
La macro doit fonctionner pour 50000 lignes.
Merci beaucoup.

 

[Xl60PassionFr]

Bonjour eastwick

Et pour les fournisseurs 122,146 et 7384 que voulez-vous faire, ce n'est pas explicite à mes yeux

Sinon, en attendant

Sub SupLigneFacSelonDate()
  Dim dLig As Long
  Application.ScreenUpdating = False
  With ThisWorkbook.Sheets("Feuil1")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Date doit être au format américain = mm/dd/yyyy
    .Range("$A$1:$N$" & dLig).AutoFilter Field:=6, Criteria1:="<11/01/2025"
    ' Supprimer toutes les autres lignes
    .Rows("2:" & dLig).Delete
    ' Afficher tout
    .ShowAllData
  End With
  Application.ScreenUpdating = True
End Sub

A+

 

[eastwick]

Bonjour ! et bien garder les lignes antérieures au 01/11/2025 (colonne F) pour ces 3 fournisseurs, merci !

 

[Xl60PassionFr]

Re,

Bonjour ! et bien garder les lignes antérieures au 01/11/2025 (colonne F) pour ces 3 fournisseurs, merci !

Dans ce cas, toujours sur l'idée du filtrage (le plus rapide)

Sub SupLigneFacSelonDate_EtNumFour()
  Dim dLig As Long
  Application.ScreenUpdating = False
  With ThisWorkbook.Sheets("Feuil1")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Inscrire temporairement une formule dans la colonne vierge [O]
    ' Test si la date est inférfieure au 01/11/2025 et si le n° fournisseur est différent des numéros indiqués
    .Range("O2:O" & dLig).FormulaLocal = _
        "=ET(F2<DATEVAL(""01/11/2025"");A2<>122;A2<>146;A2<>7384)"
    ' Date doit être au format américain = mm/dd/yyyy
    .Range("$A$1:$O$" & dLig).AutoFilter Field:=15, Criteria1:="VRAI"
    ' Supprimer toutes les autres lignes
    .Rows("2:" & dLig).Delete
    ' Afficher tout
    .ShowAllData
    ' Effacer la formule de la colonne O
    .Columns("O:O").ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

A+

 

[eastwick]

un grand merci