Discussion :

[DevJunior59]

Salut le forum !

Apres recherches j'ai pas trop trouvé réponse à ma question ...


J'ai un tableau avec des regles de mises en forme conditionnelles , ce tableau je le copie sur une autre feuille à l'aide d'une macro mais je ne trouve pas comment le copier avec un filtre qui copierait uniquement les données > 0 ( surbrillance rouge dans mes règles )..

Auriez vous une ligne de code, une piste , une méthode, fonction ou autre à me proposer ?

Bien cordialement ,

[Menhir]

Tu places un filtre sur tes données (Sélection de toutes les colonne > Ruban Données > Icone Filtrer).
Tu cliques sur le bouton apparu en entête dans la colonne que tu veux filtrer > Filtre par couleur > Rouge)

Ou bien passer par un filtre avancé : http://philippetulliez.developpez.co...dvancedfilter/

[MarcelG]

Bonjour à vous,

Hé salut Menhir!

Autre solution possible. La fonction Filtrarray de Maître Jacques que j'utilise souvent pour la gestion de 2 feuilles comme ici.

(à adapter)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub EssaifiltreArrayFonctionCol()
   Set f = Sheets("bd")
   Tbl1 = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value 
   Tbl = FiltreArrayCléColRécup(Tbl1, "Paris", 3, Array(1, 3, 4)) 
   If Not IsEmpty(Tbl) Then f.[G2].Resize(UBound(Tbl), UBound(Tbl, 2) - LBound(Tbl, 2) + 1) = Tbl
 End Sub
 
 Function FiltreArrayCléColRécup(Tbl, clé, colClé, colRécup)
   n = 0
   For i = 1 To UBound(Tbl)
     If Tbl(i, colClé) = clé Then n = n + 1
   Next i
   Dim Tbl2(): ReDim Tbl2(1 To n, LBound(colRécup) To UBound(colRécup))
   n = 0
   For i = 1 To UBound(Tbl)
     If Tbl(i, colClé) = clé Then
         n = n + 1
         For k = LBound(colRécup) To UBound(colRécup):Tbl2(n, k) = Tbl(i, colRécup(k)):Next k
     End If
   Next i
   If n > 0 Then FiltreArrayCléColRécup = Tbl2
 End Function

[boisgontierjacques]

Bonjour,

Exemple:

D2 contient: =couleurmfc(A2)=$F$2
F2 contient le no de couleur (3 ou 6)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub filtre()
    Range("A1:A1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("D1:D2"), Unique:=False
End Sub
 
Function couleurMFC(cel)
  couleurMFC = cel.DisplayFormat.Interior.ColorIndex
End Function

Boisgontier

[DevJunior59]

Parfait !

en vous remerciant .