XL 2013 Transposition de filtres multiples sur plusieurs feuilles

[BIROULIG]

Bonjour,

Je sollicite à nouveau votre aide afin de résoudre plusieurs limites de mes capacités.

J’ai une base de données que j’ai exportée et triée par années (une feuille/année et elles peuvent avoir 6000 lignes) et le but est de faire une synthèse (dans la feuille du même nom) des heures réalisée suivant un ou plusieurs filtres identiques pour toutes les années afin de suivre les tendances.

Je l’ai fait manuellement par le biais du filtre dans Excel cf voir exemple de filtre feuille 2010 (2010 pour l’année 2010 et jusqu’à cette année je me suis arrêté à 2014 pour le fichier joint) mais il faut le dupliquer manuellement à chaque feuille et donc 15 fois ce qui est lourd. Et donc j’aimerais un moyen une fois le filtre fait sur la feuille 2010 de l’appliquer aux autres feuilles par le biais d’un bouton automatiquement

Le filtre peut être multiple une colonne ex :TYPE sur une autre colonne ex COMPTE un autre filtre et dans ce filtre il peut il y avoir plusieurs sélection voir la feuille 2010.

La combinaison de filtre entre les colonnes est un ET et dans une colonne c’est un OU

Sur chaque feuille en F65534 le Total des heures apparait ce qui me permet dans la feuille synthèse

avec le bouton « actualiser » je récupère le total d’heure par feuille (pour le bouton actualiser je n’ai pas trouver comment faire une boucle pour décaler la sélection de feuille VBA, instruction commande ???)



Dernière précision je désire pouvoir annuler les filtres également afin de retrouver toute les lignes et je pour le moment je pense avoir au moins une trentaine de ligne de filtre



Désolé si je n’ai été clair et Merci d’avance

 

[sylvanu]

Bonjour Biroulig,
D'après ce que j'ai compris, peut être avec ça, en bouclant sur toutes les feuilles :

Sub BoutonCopieEssai()
Dim DEPART As Integer 'LIGNE DE DEPART
Dim NrCOL As Integer
Dim serie As Integer 'boucle de décalage de feuille d'année
Dim an As Integer    'sélection de feuille
Dim HTOTAL As Variant
Dim Nr As Integer    'Nr de ligne ou coller le total des heures du filtre
Dim Filtre As Range
If MsgBox("Etes-vous sûr de vouloir actualiser? avez vous penser à modifier vos filtres?", vbYesNo, Selection) = vbYes Then
    Filtre = Application.InputBox(prompt:="Cliquer sur la ligne du filtre à remplir dans la feuille syhthèse", Title:="lIGNE", Type:=8)
    Nr = Filtre.Row - 1
    an = 0
    ' Partie nouvelle
    For Each F In Worksheets                        ' Pour toutes les feuilles
        If F.Name <> "SYNTHESE" Then                ' Excepté la feuille SYNTHESE
            With Sheets(F.Name)                     ' Avec chaque feuille
                If .FilterMode Then .ShowAllData    ' Suppression de tous les filtres
                Sheets("SYNTHESE").[C1].Offset(Nr, an) = .Range("G65534")   ' On copie la valeur de G65534 dans Synthèse
                an = an + 1                         ' On incrémente "an"
            End With
        End If
    Next F
 End If
 End Sub

 

[BIROULIG]

Bonjour Sylvanu
merci pour la réponse extra rapide, je tâche de la tester ce soir.au pire ce W.E.
Biroulig

 

[BIROULIG]

Bonjour, Merci à Sylvanu pour la simplicité de la méthode.

j'ai testé le code qui collait quasiment: rajout du SET devant filtre et le déplacement après la copie et non l'inverse.

DONC si une solution pour dupliquer un filtrage d'une feuille aux autres serait top! autofiltre ou autre

SET Filtre = Application.InputBox(prompt:="Cliquer sur la ligne du filtre à remplir dans la feuille syhthèse", Title:="lIGNE", Type:=8)
Nr = Filtre.Row - 1
an = 0
' Partie nouvelle
For Each F In Worksheets ' Pour toutes les feuilles
If F.Name <> "SYNTHESE" Then ' Excepté la feuille SYNTHESE
With Sheets(F.Name) ' Avec chaque feuille
Sheets("SYNTHESE").[C1].Offset(Nr, an) = .Range("F65534") ' On copie la valeur de F65534 dans Synthèse
If .FilterMode Then .ShowAllData ' Suppression de tous les filtres
an = an + 1 ' On incrémente "an"
End With
End If
Next F
End If
End Sub

 

[sylvanu]

Bonjour Biroulig,
Utilisez la balise </> pour le code, c'est beaucoup plus lisible :

et utilisez l'indentation, là aussi c'est plus lisible.

j'ai testé le code qui collait quasiment:

Que signifie "quasiment" ?
Presque, pas tout à fait ....
Et le cas échéant qu'est ce qui coince ?

 

[BIROULIG]

j'ai du rajouter un set avant "filtre= Application.InputBox

Ok désolé pour la balise je tacherai de m'en souvenir à l'avenir

 

[sylvanu]

Essayez avec :

Sub essai()
Dim NrCOL As Integer
Dim serie As Integer 'boucle de décalage de feuille d'année
Dim an As Integer 'sélection de feuille
Dim HTOTAL As Variant
Dim Nr As Integer 'Nr de ligne ou coller le total des heures du filtre
Dim Filtre As Range
If MsgBox("Etes-vous sûr de vouloir actualiser? avez vous penser à modifier vos filtres?", vbYesNo, Selection) = vbYes Then
    On Error Resume Next
    Set Filtre = Application.InputBox(prompt:="Cliquer sur la ligne du filtre à remplir dans la feuille synthèse", Title:="LIGNE", Type:=8)
    If Filtre = "" Then Exit Sub
    Nr = Filtre.Row - 1
    an = 0
    For Each F In Worksheets            ' Pour toutes les feuilles
        If F.Name <> "SYNTHESE" Then    ' Excepté la feuille SYNTHESE
            With Sheets(F.Name)         ' Avec chaque feuille
                If .FilterMode Then .ShowAllData ' Suppression de tous les filtres
                Sheets("SYNTHESE").[C1].Offset(Nr, an) = .Range("F65534") ' On copie la valeur de F65534 dans Synthèse
                an = an + 1             ' On incrémente "an"
            End With
        End If
    Next F
End If
End Sub

 

[sylvanu]

j'ai du rajouter un set avant "filtre= Application.InputBox

Ne pas oublier les deux lignes :

On Error Resume Next
...
If Filtre = "" Then Exit Sub

Dans le cas où dans l'inputbox on cliquerait sur OK sans avoir sélectionner de range.

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @BIROULIG , @sylvanu
J'arrive un peu tard sur le sujet mais je propose quand même ce que j'ai fait
j'ai transformé les plages utilisé en tableaux structurés
j'ai ajouté une colonne "Visible" à chacun des tableaux annuels (pour les formule dans la feuille de synthèse)
j'ai remonté les sous-totaux des feuilles année sur la 2ème ligne.
J'ai créé une macro pour propager les filtres de la feuille 2010 aux feuilles des autres années (bouton dans la feuille 2010)
j'ai crée une feuille "SynthèseB" avec un tableau structuré qui prend en compte par formule les filtres appliqués aux feuilles des années.
Macro Propager :

Sub Propager_Filtres()
     Set Source = [tb_2010].ListObject
'RàZ des anciens filtres
     For Each WS In ThisWorkbook.Worksheets
          If WS.Name <> "2010" And WS.Name <> "SynthèseB" Then
               WS.ListObjects(1).AutoFilter.ShowAllData
          End If
     Next
'Propagation des filtres de la feuille "2010" sur les feuilles des autres année
     For Each Filtre In Source.AutoFilter.Filters
          N° = N° + 1
          If Filtre.On Then
               With Filtre
                    Opérateur = IIf(.Operator = 0, xlAnd, .Operator)
                    Critère1 = .Criteria1
                    Critère2 = "Erreur": On Error Resume Next: Critère2 = .Criteria2: On Error GoTo 0
               End With
               For Each WS In ThisWorkbook.Worksheets
                    If WS.Name <> "2010" And WS.Name <> "SynthèseB" Then
                         With WS.ListObjects(1)
                              If Critère2 = "Erreur" Then
                                   .Range.AutoFilter Field:=N°, Criteria1:=Critère1, Operator:=Opérateur
                              Else
                                   .Range.AutoFilter Field:=N°, Criteria1:=Critère1, Operator:=Opérateur, Criteria2:=Critère2
                              End If
                         End With
                    End If
               Next
          End If
    
     Next

End Sub

Formule de la feuille SynthèseB :

=SIERREUR(SOMMEPROD(INDIRECT("tb_"&C$2&"[Heures]");--(INDIRECT("tb_"&C$2&"[Type]")=$B3);--(INDIRECT("tb_"&C$2&"[Visible]")));"-")

( les entêtes du tableau étant en ligne 2, la colonne "Type" en colonne B, formule en C3 à recopier sur toutes les colonnes).

voir le fichier joint

A bientôt

 

[BIROULIG]

Bonjour, AtTheOne , je viens de voir le fichier, Il convient tout à fait Merci. celui de Sylvanu répondait avec second code pour un point.
Je vais voir si j'arrive à le transposer à mon fichier final qui est bien plus volumineux, en passant par des tableaux structurés que je ne connait que vaguement. Je vais essayer de comprendre un peu le code de propagation car tout ce qui est "critère" ???
Je ne ferme pas post pour le moment au cas où ...
Merci encore pour votre aide à toi et à Sylvanu

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @BIROULIG
Pour la propagation, j'utilise les objets " "Filter" de l' "AutoFilter" du "ListObject"
Le ListObject c'est le Tableau Structuré,
l'AutoFilter c'est les filtres automatiques du TS,
les "Filter" ce sont les filtres de chaque colonne individuelle.
On sait si la colonne a un filtre actif en testant sa propriété .On
Si c'est le cas, on reprend les propriétés .Criteria1, .Operator et éventuellement .Criteria2 qui décrivent le filtre actif pour le reproduire sur le TS des autres feuilles.
Les seuls tests à faire c'est si .On vaut True et si .Criteria2 est défini (dans mon code si Critère2 est différent de "Erreur").

À bientôt

 

[BIROULIG]

Bonjour AtTheOne, Merci pour les explications sur le fonctionnement je pourrai le réutilisé par la suite, et vous m'éviter des recherche afin de me documenter. Respect! je tache de voir ça ce WE.