[XL-2007] Faire un filtre suivant la couleur de fond de la cellule [Résolu]

Fred4345 · 12/11/2011, 13h26

Etant complètement débutant en VBA, j'ai fait une macro avec l'outil automatique. Dans un premier temps, je cherche à filtrer les cellules dont le fond est colorisée. Je dois filtrer les résultats sur 3 colonnes différentes. Ensuite je copie certaines données obtenus pour les coller dans une autre feuille du même classeur. Le problème avec ma macro automatique est que la plage de cellule à copiée ne change pas. Les données à copier sont fonctions des cellules colorisés qui changent suivant la mise en forme conditionné par un calcul!
Comment faire pour modifier ce code?

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
23
24
25
Sub Trier()
'
' Trier Macro
'
 
'
    Sheets("BASE").Select
    Columns("J:J").Select
    Selection.AutoFilter
    ActiveSheet.Range("$J$1:$J$63186").AutoFilter Field:=1, Criteria1:=RGB(255 _
        , 0, 0), Operator:=xlFilterCellColor
    Range("C12:C51,K12:K51").Select
    Range("K12").Activate
    Selection.Copy
    Sheets("Commande").Select
    Range("A6").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("BASE").Select
    ActiveSheet.Range("$J$1:$J$63186").AutoFilter Field:=1
    Application.CutCopyMode = False
    Range("A2").Select
    Selection.AutoFilter
    Sheets("Gestion Bobine").Select
End Sub

mercatog · 12/11/2011, 13h42

Peut être pour copier les lignes visibles de la colonne C de la feuille Base vers A6 de la feuille Commande et ceux de la colonne K de la feuille Base vers B6

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
Sub Trier()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("BASE")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "J").End(xlUp).Row
    .Range("J1:J" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    If .Range("J1:J" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Union(.Range("C2:C" & LastLig), .Range("K2:K" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    .AutoFilterMode = False
End With
End Sub

Daniel.C · 12/11/2011, 14h05

Bonjour,

Une autre façon de faire :

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
Sub Trier()
    Dim Plage As Range
    With Sheets("BASE")
        .Columns("J:J").AutoFilter
        .Range("J:J").AutoFilter Field:=1, Criteria1:=RGB(255 _
            , 0, 0), Operator:=xlFilterCellColor
        Set Plage = .AutoFilter.Range.Offset(1)
        If Plage.Rows.Count > 1 Then
            Set Plage = Plage.Resize(Plage.Rows.Count - 1, 1)
            Set Plage = Union(Plage.Offset(, -7), Plage.Offset(, 1))
            Plage.Copy
            Sheets("Commande").Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Sheets("BASE").Select
            ActiveSheet.Range("J:J").AutoFilter Field:=1
            Application.CutCopyMode = False
        End If
    End With
End Sub

Fred4345 · 12/11/2011, 14h16

Le code fonctionne parfaitement pour trier sur une colonne et ensuite copier coller dans une autre feuille.

J'essaye de le modifier pour faire un filtre en même temps sur une autre colonne du même tableau et effectuer la même opération pour coller le tous à partir de A6 sur la feuille "commande" à la suite du résultat trouvé précédemment.
Forcément je bloque à partir de if. Voici ce que j'essaye mais je pense que ça ne marchera pas?

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
Sub Trier()
Dim LastLig As Long
Dim Lastlig1 As Long
 
Application.ScreenUpdating = False
With Worksheets("BASE")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "L").End(xlUp).Row
    Lastlig1 = .Cells(.Rows.Count, "S").End(xlUp).Row
    .Range("L1:L" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    .Range("S1:S" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    If .Range("L1:L" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Union(.Range("E2:E" & LastLig), .Range("M2:M" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    .AutoFilterMode = False
End With
End Sub

Daniel.C · 12/11/2011, 14h20

@ mercatog :

Citation:

Code :

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

LastLig = .Cells(.Rows.Count, "J").End(xlUp).Row

Il me semble qu'il faut filtrer sur la colonne entière au cas où il y a des cellules vides rouges... qu'il importerait de copier.

Fred4345 · 12/11/2011, 14h37

Voici comment j'ai changé le code de Mercatog. Pour essayer le code je vais coller en B . Le filtre ne fonctionne pas sur la colonne S. Je cherche les cellules avec un fond jaune!

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
23
24
25
26
Sub Trier()
Dim LastLig As Long
Dim Lastlig1 As Long
 
Application.ScreenUpdating = False
With Worksheets("BASE")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "L").End(xlUp).Row
    Lastlig1 = .Cells(.Rows.Count, "S").End(xlUp).Row
    .Range("L1:L" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    .Range("S1:S" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    If .Range("L1:L" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Union(.Range("E2:E" & LastLig), .Range("M2:M" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    .AutoFilterMode = False
    If .Range("S1:S" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Union(.Range("N2:N" & LastLig), .Range("T2:T" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("B6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    .AutoFilterMode = False
 
End With
End Sub

Daniel.C · 12/11/2011, 18h36

Sur une même feuille, tu ne peux filtrer qu'une plage. Ecris :

Code :

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

1
2
    .Range("L1:S" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    .Range("L1:S" & LastLig).AutoFilter Field:=8, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor

au lieu de :

Code :

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

1
2
    .Range("L1:L" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    .Range("S1:S" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor

Fred4345 · 12/11/2011, 19h06

Peux-tu me mettre des commentaires pour m'expliquer et que je comprenne ces lignes stp.
Cela fonctionne que partiellement en retirant la ligne 17 et en mettant ta modification.
En faite, je récupère que les données qui ont des cellules colorées communes. Les autres ne sont pas copiées. Pourtant il me les faut aussi.
J'ai besoin de filtrer sur plusieurs colonnes et de récupérer ensuite des données en les mettant à la suite à partir de la cellule A6.
Comment dois je faire pour y arriver?
Je pensais que je pouvais appliquer des filtres à la suite en utilisant les couleurs de fond.

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
23
24
25
26
Sub Trier()
Dim LastLig As Long
Dim Lastlig1 As Long
 
Application.ScreenUpdating = False
With Worksheets("BASE")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "L").End(xlUp).Row
    Lastlig1 = .Cells(.Rows.Count, "S").End(xlUp).Row
    .Range("L1:S" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    .Range("L1:S" & LastLig).AutoFilter Field:=8, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    If .Range("L1:L" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Union(.Range("E2:E" & LastLig), .Range("M2:M" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    '.AutoFilterMode = False
    If .Range("S1:S" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Union(.Range("N2:N" & LastLig), .Range("T2:T" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("C6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    .AutoFilterMode = False
 
End With
End Sub

Voici le code fait avec une macro automatique. Le problème est que les données changent. Dans ce cas je copie toujours les mêmes cellules et je les colle toujours sur les mêmes cellules de la feuille"commande", en écrasant les données du premier filtre. Elles ne se mettent pas à la suite.

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub TRIE()
'
' TRIE Macro
'
 
'
    Sheets("BASE").Select
    Columns("L:L").Select
    Selection.AutoFilter
    ActiveSheet.Range("$L$1:$L$63186").AutoFilter Field:=1, Criteria1:=RGB(255 _
        , 0, 0), Operator:=xlFilterCellColor
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.SmallScroll Down:=-15
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    Range("E15:E60").Select
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    Range("E15:E60,M15:M60").Select
    Range("M15").Activate
    Selection.Copy
    Sheets("Commande").Select
    ActiveSheet.Paste
    Sheets("BASE").Select
    ActiveSheet.Range("$L$1:$L$63186").AutoFilter Field:=1
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.SmallScroll Down:=-25
    Columns("S:S").Select
    Selection.AutoFilter
    ActiveSheet.Range("$S$1:$S$63186").AutoFilter Field:=1, Criteria1:=RGB(255 _
        , 255, 0), Operator:=xlFilterCellColor
    Range("N52:N60,T52:T60").Select
    Range("T52").Activate
    Selection.Copy
    Sheets("Commande").Select
    Range("A11").Select
    ActiveSheet.Paste
    Range("A14").Select
    Sheets("BASE").Select
    ActiveSheet.Range("$S$1:$S$63186").AutoFilter Field:=1
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    Sheets("Gestion Bobine").Select
End Sub

tiktak28 · 12/11/2011, 19h36

Salut,

JE voudrai savoir tu les colorises en fonction de quoi? tu fais une mise en forme conditionnelle?

Ca m'intéresse parce que j'ai à peu près le meme souci que toi

Le filtre élaboré pourrait convenir mieux qu'une macro je pense, non?

mercatog · 12/11/2011, 19h41

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Trier()
Dim LastLig As Long, N As Long
 
Application.ScreenUpdating = False
With Worksheets("BASE")
    'On supprime l'éventuel iltre automatique
    .AutoFilterMode = False
    'Ligne de la dernière cellule remplie
    LastLig = .UsedRange.Rows.Count
 
    'On filtre la colonne L
    .Range("L1:L" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    'N: Nombre de lignes visibles y compris la ligne 1 des titres
    N = .Range("L1:L" & LastLig).SpecialCells(xlCellTypeVisible).Count
    'Si on a au moins 2 lignes (y compris celle des titres)
    If N > 1 Then
        'On copie les n-1 lignes vers A6 de la feuille Commande
        Union(.Range("E2:E" & LastLig), .Range("M2:M" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    'On enlnève le filtre auto
    .AutoFilterMode = False
 
    'On filtre la colonne S
    .Range("S1:S" & LastLig).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    'Si on a au moins 2 lignes (y compris celle des titres)
    If .Range("S1:S" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        'On copie les lignes vers A6+n-1 de la feuille Commande
        Union(.Range("N2:N" & LastLig), .Range("T2:T" & LastLig)).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Commande").Range("A" & N + 5).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    'On enlnève le filtre auto
    .AutoFilterMode = False
End With
End Sub

@ Daniel.C, LastLig telle était une indication et non une option pour tous les cas de figure.

Fred4345 · 12/11/2011, 20h08

Pour tiktak28, je colorise avec une mise en forme conditionnée suivant la valeur d'une autre cellule. Je passe par le VBA car le projet sur lequel je travaille sera utilisé par plusieurs personnes qui ne connaissent pas Excel ou très peu!
Tout seul j'utiliserai seulement excel sans code VBA car je suis plus que débutant en VBA.
Pour Mercatog, merci beaucoup. Cela fonctionne très bien.

C'est exactement ma recherche.
Merci également pour les commentaires en face du code.

De cette manière je vais tacher de me débrouiller seul pour le troisième filtre!
Ainsi les novices comme moi, peuvent également progresser dans notre démarche d'apprendre ce language.

12/11/2011, 19h36	#9
tiktak28 Invité de passage Inscription : novembre 2011 Messages : 8 Détails du profil Informations personnelles : Sexe : Localisation : France Informations forums : Inscription : novembre 2011 Messages : 8 Points : 3 Points : 3	Salut, JE voudrai savoir tu les colorises en fonction de quoi? tu fais une mise en forme conditionnelle? Ca m'intéresse parce que j'ai à peu près le meme souci que toi Le filtre élaboré pourrait convenir mieux qu'une macro je pense, non?
	00

12/11/2011, 20h08	#11
Fred4345 Candidat au titre de Membre du Club Inscription : juin 2011 Messages : 122 Détails du profil Informations forums : Inscription : juin 2011 Messages : 122 Points : 13 Points : 13	Pour tiktak28, je colorise avec une mise en forme conditionnée suivant la valeur d'une autre cellule. Je passe par le VBA car le projet sur lequel je travaille sera utilisé par plusieurs personnes qui ne connaissent pas Excel ou très peu! Tout seul j'utiliserai seulement excel sans code VBA car je suis plus que débutant en VBA. Pour Mercatog, merci beaucoup. Cela fonctionne très bien. C'est exactement ma recherche. Merci également pour les commentaires en face du code. De cette manière je vais tacher de me débrouiller seul pour le troisième filtre! Ainsi les novices comme moi, peuvent également progresser dans notre démarche d'apprendre ce language.
	00

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email