Copier coller données triées feuilles VBA

Bonsoir à toutes et à tous,

J'ai besoin d'assistance à propos d'une programmation vba.

En clair, je souhaiterais automatiser par une macro une extraction de données : faire le tri selon un filtre reprenant deux variables, copier le résultat, créer une nouvelle feuille dénommée et coller le résultat sur cette nouvelle tout en reprenant les dimensions identiques du tableau de base.

J'indique ci-après les commandes vba :

Sub Macro4()

'

' Extraction Encours

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=9, Criteria1:= _

"EN COURS"

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=9, Criteria1:= _

"=EN COURS", Operator:=xlOr, Criteria2:="=EN SUSPENS"

Rows("2:3000").Select

Selection.Copy

' Insère Feuille dénommée

Dim shEncours As Worksheet

Set shEncours = Sheets.Add(After:=Sheets(Sheets.Count))

shEncours.Name = "Encours"

ActiveSheet.Paste

Rows("1:1").Select

' Copier coller tableau dimensions identiques

Rows("2:3000").Select

Selection.Copy

Sheets.Add

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _

xlNone, SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

End Sub

Le problème réside dans la dimension exacte du tableau collé par rapport au tableau copié.

Je joins le fichier de base.

Merci par avance de vos indications précieuses.

Excellente soirée.

Rodi95

Salut Rodi et bienvenue sur le Forum,

A voir si la ‘’Macro1’’ placée derrière le bouton ‘’Copie En cours’’ sur la feuille ‘’ Encours_base’’ du fichier ci-joint correspond à ton attente.

Sub Macro1()

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

ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).Name).Range.AutoFilter Field:=9, Criteria1:= _
    "=EN COURS", Operator:=xlOr, Criteria2:="=EN SUSPENS"

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

End Sub

Amicalement.

EDIT : Si tu veux supprimer les données inutiles sur la feuille ''Encours'' nouvellement créée, tu peux utiliser la macro ci-dessous, placée dans le nouveau fichier joint :

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

Bonsoir Yvouille,

Merci beaucoup pour tes indications.

Je les regarde demain soir et te tiens informé du résultat.

Excellente soirée.

Bien cordialement.

Rodi95

Bonsoir Yvouille,

Tout fonctionne parfaitement!

Merci beaucoup pour ton aide précieuse.

Je clôture le post.

Excellente soirée.

Bien cordialement.

Rodi95