Conserver une MEFC avec un filtre élaboré

[C60a]

Bonjour à tous,

Comment puis-je conserver une mise en forme conditionnelle lors d'une application d'un filtre élaboré ?

Private Sub Worksheet_Activate()
    [T2] = "En attente"
    derlig = Sheets("Feuil1").[A1].End(xlDown).Row
    derlign = [A1].End(xlDown).Row
    Range("A2:C" & derlign).Delete

    With Sheets("Feuil1")
        .Range("A1:C" & derlig).AdvancedFilter Action:=xlFilterCopy, _
                                               CriteriaRange:=.[T1:T2], _
                                               CopyToRange:=[A1:C1], Unique:=False
    End With
End Sub

la mise en forme utilisée est celle d'un jeux d’icônes à 4 indicateurs avec un "Ordre inverse des icônes" et "Afficher l'icone uniquement" .

Merci d'avance.

 

[C60a]

Bonjour,

Voila un autre essai :

Private Sub Worksheet_Activate()
    Dim Derlig As Byte
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    ActiveSheet.Cells.Delete

    With Sheets("Feuil1")
        .[T2] = "En cours"
        Derlig = .[A1].End(xlDown).Row
        .Range("A1:C" & Derlig).AdvancedFilter Action:=xlFilterInPlace, _
                                               CriteriaRange:=.[T1:T2], _
                                               Unique:=True
        .Range("A1:C" & Derlig).SpecialCells(xlCellTypeVisible).Copy
    End With
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Feuil1").AutoFilterMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Il consiste à appliquer un filtre avancé sur place puis recopier le résultat dans Feuil2.

Mais je n'obtient rien !

 

[Staple1600]

Bonsoir à tous

Quand j'active, la feuille 2, j'ai bien une recopie sur la feuille 2 des données filtrées ave conservation de la MFC
(testé sur Excel 2013)
NB: Si ta macro a généré au moins une fois une erreur
mets cette macro dans un module standard et éxécutes là en étant dans VBE.

Sub Macro1()
Application.EnableEvents = True
End Sub

Sinon, je me suis permis ce petit ajout

Private Sub Worksheet_Activate()
    Dim Derlig As Long
    Application.ScreenUpdating = False
    'Application.EnableEvents = False
    Cells.Clear
    With Sheets("Feuil1")
        .[T2] = Choose(InputBox("Choisir le critère?" & Chr(13) & "1=En cours, 2=Annulé, 3=En attente", "Filtre", 1), "En cours", "Annulé", "En attente")
        Derlig = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A1:C" & Derlig).AdvancedFilter Action:=xlFilterInPlace, _
                                               CriteriaRange:=.[T1:T2], _
                                               Unique:=True
        .Range("A1:C" & Derlig).SpecialCells(xlCellTypeVisible).Copy
    End With
    ActiveSheet.[A1].Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Feuil1").ShowAllData
    Application.ScreenUpdating = True
   ' Application.EnableEvents = True
End Sub

 

[C60a]

Bonjour Staple1600,

je me suis permis ce petit ajout

Il m'a été très utile (Ne pas utiliser plus d'une feuille pour afficher le résultat du filtre).

Merci