Copier coller données triées feuilles VBA_évolution

Bonsoir,

J'ai un souci pour faire évoluer une macro permettant de faire un tri entre des dossiers.

Précisément, Yvouille m'a, à l'époque, donné la macro suivante qui correspondait à mon besoin :

Option Explicit

Sub Macro1()

Dim DerLig As Long

Sheets("Encours_base").Copy Before:=Sheets(2)

Sheets("Encours_base (2)").Name = "Encours"

DerLig = Range("K" & Rows.Count).End(xlUp).Row

ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9, Criteria1:= _

"<>EN COURS", Operator:=xlAnd, Criteria2:="<>EN SUSPENS"

Rows("3:" & DerLig).Delete Shift:=xlUp

ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9

ActiveSheet.Shapes.Range(Array("Button 1")).Delete

End Sub

Aujourd'hui, j'ai besoin d'inclure les dossiers "OUVERT".

Aussi, j'ai modifié la commande comme suit :

Option Explicit

Sub Encours()

Dim DerLig As Long

Sheets("Encours_base").Copy Before:=Sheets(2)

Sheets("Encours_base (2)").Name = "Encours"

DerLig = Range("K" & Rows.Count).End(xlUp).Row

ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9, Criteria1:= _

"<>OUVERT", Operator:=xlAnd, Criteria2:="<>EN COURS", Operator:=xlAnd, Criteria3:="<>EN SUSPENS"

Rows("3:" & DerLig).Delete Shift:=xlUp

ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9

ActiveSheet.Shapes.Range(Array("Button 1")).Delete

End Sub

Or, la commande modifiée ne fonctionne pas et je reste bloqué.

Vous trouverez le fichier en cause ci-joint et l'ancien post

https://forum.excel-pratique.com/excel/copier-coller-donnees-triees-feuilles-vba-t72334.html

Merci par avance de votre soutien.

Cordialement.

Rodi95

Salut,

Voici une macro qui fonctionne pour ton fichier :

Option Explicit
Sub Macro1()
Dim DerLig As Long

Sheets("Encours_base").Copy Before:=Sheets(2)
Sheets("Encours_base (2)").Name = "Encours"

DerLig = Range("K" & Rows.Count).End(xlUp).Row

ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9, Criteria1:="=CLOTURE", Operator:=xlOr, Criteria2:="="
Rows("3:" & DerLig).Delete Shift:=xlUp
ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9
ActiveSheet.Shapes.Range(Array("Button 1")).Delete

End Sub

Cordialement.

Bonsoir Yvouille,

Votre aide est toujours aussi précieuse!

Merci beaucoup encore une fois.

Je marque le post comme clôturé.

Excellente soirée.

Bien cordialement.

Rodi95

Rechercher des sujets similaires à "copier coller donnees triees feuilles vba evolution"