Discussion :

[tintin69]

Bonjour,

Je souhaiterai savoir comment faire pour filtrer plusieurs onglets selon un critère porté sur une colonne ?
Ce que je fais actuellement : pour chaque mois je met un filtre en colonne A et je décoche "ne pas imprimer" et je répète l'opération sur 12 mois.

Je pensais qu'avec du VBA c'était possible qui fasse soit un filtre des 12 mois d'un coups ou une sélection du mois à filtrer, je ne sais pas trop comment faire, j'ai essayé avec l'enregistreur de macro mais ça n'a rien donné de concluant.
Mon fichier est assez volumineux j'ai dû le mettre en ligne sur Cjoint.
http://www.cjoint.com/data/0CnmCO016kT.htm

Merci d'avance.
Bonne journée

[Invité]

Bonjour,


Une solution possible dans le fichier joint (j'ai supprimé tous les onglets non visibles).

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
65
66
67
68
69
Option Explicit
Option Base 1
 
Sub FiltrerTousLesMois()
 
Dim ListeDesMois As Variant
Dim I As Long
Dim Continuer As Boolean
Dim Sh As Worksheet
Dim MoisNonTrouves As String
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    ListeDesMois = Array("Septembre", "Novembre", "Octobre", "Décembre", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout")
    MoisNonTrouves = "Les mois suivants n'ont pas été trouvés : " & Chr(10)
    With Sheets("MENU")
 
         For I = LBound(ListeDesMois, 1) To UBound(ListeDesMois, 1)
             Continuer = False
             For Each Sh In Worksheets
                 If Sh.Name = ListeDesMois(I) Then
                    Continuer = True
                    If .Range("OptionFiltre") = "Avec filtre" Then
                       MiseEnPlaceFiltre Sheets(ListeDesMois(I)), True
                    Else
                       MiseEnPlaceFiltre Sheets(ListeDesMois(I)), False
                    End If
                 End If
             Next Sh
             If Continuer = False Then
                MoisNonTrouves = MoisNonTrouves & ListeDesMois(I) & Chr(10)
             End If
        Next I
    End With
 
    If MoisNonTrouves <> "Les mois suivants n'ont pas été trouvés : " & Chr(10) Then
        MsgBox MoisNonTrouves, vbCritical
    End If
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
 
    MsgBox "Fin du filtrage ou défiltrage", vbInformation
 
End Sub
 
 
 
Sub MiseEnPlaceFiltre(ByVal FeuilleAFiltrer As Worksheet, ByVal AFiltrer As Boolean)
 
    With FeuilleAFiltrer
 
         If Not .AutoFilterMode Then .Range("A1").AutoFilter
 
         If AFiltrer = True Then
            If .FilterMode = True Then
               .ShowAllData
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            Else
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            End If
         Else
            If .FilterMode = True Then .ShowAllData
         End If
 
    End With
 
End Sub

Dans chaque onglet, vous pouvez mettre en oeuvre le filtre ou non sur clic droit de la souris :

Code présent dans le module de chaque onglet.

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
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
     If Target.Count > 1 Then Exit Sub
 
      With ActiveSheet
 
            If .FilterMode = True Then
               .ShowAllData
            Else
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            End If
    End With
 
 
End Sub

Cordialement.

[tintin69]

Bonjour,

Tout d'abord merci pour votre assistance.

C'est énorme ; ça fonctionne. Comment Est-ce que vous avez fait ??

Pour info. j'avais essayé de bricoler un code ; il fonctionnait mais n'est peut être pas aussi efficace que le votre.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Filtre_tous_les_mois()
Application.ScreenUpdating = False
     Dim DerLig As Long, An
     An = Array("", "Septembre", "Octobre", "Novembre", "Décembre", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout")
     For i = 1 To 12
    With Sheets(An(i))
             DerLig = .Cells(.Rows.Count, 2).End(xlUp).Row
             .AutoFilterMode = False
             .Range(.[A1], .Cells(DerLig, 1)).AutoFilter 1, "<>ne pas imprimer"
         End With
     Next i
Application.ScreenUpdating = True
 End Sub

Je dis bravo ; Microsoft devrait vous embaucher .

Par contre comment est ce que vous avez fait pour faire la liste déroulante sans filtre avec filtre de telle manière à ce qu'elle soit liée à la macro ?
et si je conserve mes onglets masqués Est-ce que je peux le faire ???

merci d'avances, bonne journée.
Cordialement.

[Invité]

Je dis bravo ; Microsoft devrait vous embaucher .

Non, malheureusement plus personne n'achèterait Excel....

Par contre comment est ce que vous avez fait pour faire la liste déroulante sans filtre avec filtre de telle manière à ce qu'elle soit liée à la macro ?

Dans le module de l'onglet Menu, la macro événementielle BoutonFiltrer_click lance le programme :

Code :

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

1
2
3
4
 
Private Sub BoutonFiltrer_Click()
        FiltrerTousLesMois
End Sub

Vous pourriez aussi supprimer le bouton et modifier la macro existante dans le module de l'onglet Menu :

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Change(ByVal Target As Range)
 
 If Target.Count > 1 Then Exit Sub
 
 If Not Intersect(Range("b19"), Target) Is Nothing Then Sheets(Target.Value).Select
 If Not Intersect(Range("OptionFiltre"), Target) Is Nothing Then FiltrerTousLesMois
 
 
End Sub

et si je conserve mes onglets masqués Est-ce que je peux le faire ???

Oui, la macro n'interfère pas sur ces onglets puisqu'on ne prend que les onglets appartenant à la liste des mois de septembre à août dans la matrice ListeDesMois.


Attention : J'ai remplacé le fichier joint ce matin, prenez bien celui qui est actuellement en place et supprimez la version d'hier si c'est celle que vous avez chargée.

Cordialement.

[tintin69]

Bonjour,

Merci beaucoup pour tous ces conseils

Avant de tenter de faire ce que vous avez fait ; et je voudrais être certains de comprendre le mécanisme :

Etape préalable 0 :
=> Créer une liste déroulante en B13 (validation des données ; listes : "avec filtres";"sans filtres".


Etape 1 - on place dans l'onglet "feuil1 (MENU)" cette action suivante :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     If Target.Count > 1 Then Exit Sub
      With ActiveSheet
            If .FilterMode = True Then
               .ShowAllData
            Else
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            End If
    End With 
    Cancel = False
End Sub

Etape 2- mettre dans chaque mois onglet "feuil.. (Septembre)"; etc...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     If Target.Count > 1 Then Exit Sub
           With ActiveSheet
                If .FilterMode = True Then
               .ShowAllData
            Else
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            End If
    End With
    Cancel = False
End Sub

Etape 3 - Création d'une macro

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
Option Explicit
Option Base 1
Sub FiltrerTousLesMois()
Dim ListeDesMois As Variant
Dim I As Long
Dim Continuer As Boolean
Dim Sh As Worksheet
Dim MoisNonTrouves As String
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        ListeDesMois = Array("Septembre", "Novembre", "Octobre", "Décembre", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout")
    MoisNonTrouves = "Les mois suivants n'ont pas été trouvés : " & Chr(10)
    With Sheets("MENU")
 
         For I = LBound(ListeDesMois, 1) To UBound(ListeDesMois, 1)
             Continuer = False
             For Each Sh In Worksheets
                 If Sh.Name = ListeDesMois(I) Then
                    Continuer = True
                    If .Range("OptionFiltre") = "Avec filtre" Then
                       MiseEnPlaceFiltre Sheets(ListeDesMois(I)), True
                    Else
                       MiseEnPlaceFiltre Sheets(ListeDesMois(I)), False
                    End If
                 End If
             Next Sh
             If Continuer = False Then
                MoisNonTrouves = MoisNonTrouves & ListeDesMois(I) & Chr(10)
             End If
        Next I
    End With
        If MoisNonTrouves <> "Les mois suivants n'ont pas été trouvés : " & Chr(10) Then
        MsgBox MoisNonTrouves, vbCritical
    End If
        Application.ScreenUpdating = True
    Application.EnableEvents = True
       MsgBox "Fin du filtrage ou défiltrage", vbInformation
    End Sub
Sub MiseEnPlaceFiltre(ByVal FeuilleAFiltrer As Worksheet, ByVal AFiltrer As Boolean)
 
    With FeuilleAFiltrer
 
         If Not .AutoFilterMode Then .Range("A1").AutoFilter
 
         If AFiltrer = True Then
            If .FilterMode = True Then
               .ShowAllData
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            Else
               .Columns(1).AutoFilter Field:=1, Criteria1:="="
            End If
         Else
            If .FilterMode = True Then .ShowAllData
         End If
 
    End With
 
End Sub

La procédure est elle correcte ou y a t il des étapes à modifier ?

[Invité]

Avant de tenter de faire ce que vous avez fait ; et je voudrais être certains de comprendre le mécanisme :

Bonjour,

L'étape 2 n'est pas indispensable. C'est à vous de voir si vous souhaitez filtrer ou "défiltrer" directement sur la feuille. Cela peut être utile en cas de nouvelle impression.

Les étapes 1 et 3 sont indissociables.

Si vous craignez d'endommager votre base, créez une copie de votre fichier et travaillez sur celle-ci.

Cordialement.

[Invité]

Les étapes 1 et 3 sont indissociables.

Je n'avais pas fait attention :

Dans la feuille Menu, vous devez avoir pour l'étape 1 :

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Change(ByVal Target As Range)
 
 If Target.Count > 1 Then Exit Sub
 
 If Not Intersect(Range("b19"), Target) Is Nothing Then Sheets(Target.Value).Select
 If Not Intersect(Range("OptionFiltre"), Target) Is Nothing Then FiltrerTousLesMois
 
 
End Sub

Cordialement.

[tintin69]

J'ai réussi à reproduire j'avais quelques soucies de syntaxe le problème est résolu ; merci beaucoup pour votre aide.

J'ai juste une question dans l'onglet MENU quelle est la différence entre la commande suivante :

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_Change(ByVal Target As Range)
 
 If Target.Count > 1 Then Exit Sub
 
 If Not Intersect(Range("b19"), Target) Is Nothing Then Sheets(Target.Value).Select
 If Not Intersect(Range("OptionFiltre"), Target) Is Nothing Then FiltrerTousLesMois
 
End Sub

et la commande :

Code :

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

1
2
3
4
5
Option Explicit
 
Private Sub BoutonFiltrer_Click()
        FiltrerTousLesMois
End Sub

[Invité]

J'ai juste une question dans l'onglet MENU quelle est la différence entre la commande suivante :
Private Sub Worksheet_Change(ByVal Target As Range)
et la commande :
Private Sub BoutonFiltrer_Click()

Bonjour,

-Avec la macro Sub Worksheet_Change, la macro FiltrerTousLesMois est lancée dès que vous changez la valeur de la cellule "OptionFiltre" avec la liste déroulante "Avec filtre", "Sans filtre"
-Avec la macro BoutonFiltrer_Click(), c'est le bouton "Filtrer ou Défiltrer" qui lance la macro FiltrerTousLesMois.

Il est plus simple d'utiliser Sub Worksheet_Change et de supprimer le bouton.

Cordialement.