Création Liste avec Critères / Données multi feuilles

Bonjour à tous,

Je fais appel à l'expertise des membre de ce forum pour améliorer un outil de gestion.

Je travaille sur un classeur Excel qui se compose de plusieurs onglets, chacun comprenant un tableau de données.

J'aimerais dans un nouvel onglet mettre en place une requête me permettant de regrouper l'ensemble des données des différents onglets.

En revanche, il faudrait que je puisse mettre en place un critère dans cette sélection. Par exemple, je voudrais lister toutes les lignes de mes différents onglets répondant au critère : "couleur de la case en colonne C est jaune" ou encore "texte de la colonne B contient "Chirurgie"".

Je suis tombé sur des cas similaires utilisant les fonctions INDEX, EQUIV, ou les formules matricielles mais je n'ai jamais réussi à m'en sortir.

Je joins un fichier factice standard afin que vous puissiez visualiser le type d'outil.

Merci d'avance pour votre aide,

Très bonne journée

WAXSCUD

46exemple.xlsx (10.42 Ko)

Re-bonjour,

Je précise que depuis hier j'ai découvert certaines fonctions se rapprochant de la solution.

Au départ les filtres avancés étaient tentants mais malheureusement, impossible d'extraire depuis plusieurs onglets.

Puis un code VBA qui commence à me plaire...

Si vous avez des suggestions pour l'améliorer ou une alternative je suis preneur

Sub Test()
Sheets("Liste").Range("B1").CurrentRegion.Offset(2, 0).Clear
For Each X In Sheets
    If X.Name Like "*Feuille*"  Then
        For Each Y In X.Range("A2:A" & X.Range("A1000").End(xlUp).Row)
            If (Y.Offset(0, 2).Value Like "Chir*" Then
                Set Dest = Sheets("Liste").Range("B1000").End(xlUp).Offset(1, 0)
                Dest.Value = UCase(X.Name)
                Y.Resize(1, 2).Copy Dest.Offset(0, 1)
            End If
        Next
    End If
Next

Merci beaucoup,

waxscud

Bonjour.

waxscud a écrit :

Au départ les filtres avancés étaient tentants mais malheureusement, impossible d'extraire depuis plusieurs onglets.

Pour « chirurgie » aucun souci pourtant onglet par onglet ! Sans complément d'informations …

Sinon pour la couleur c'est déjà possible via un simple filtre …

Bonjour Marc,

Et merci pour ta réponse !

Je ne saisis pas bien ta remarque en revanche.

Je sais que l'on peut appliquer des filtres sur chaque onglet.

Je sais aussi que l'on peut appliquer des filtres plus complexes sur un tableau et exporter le résultat sous un autre tableau.

Le problème est que je voudrais que ma requête active le même filtre sur différents onglets et m'affiche les résultats regroupés au sein d'une même liste dans autre onglet.

Je crois que les filtres automatiques et élaborés ne le peuvent pas.

Visiblement VBA est le seul moyen..

waxscud

Aucun souci en effectuant un filtre avancé par feuille source copiant le résultat dans la même feuille de destination …

Dans la même feuille de destination oui mais dans le même tableau je vois pas comment

Peux tu m'éclairer ?

Merci beaucoup

Warren

Tableau ou feuille, c'est du pareil au même !

Sub Demo()
With Feuil4
    Application.ScreenUpdating = False
    .[B2].CurrentRegion.Offset(1).Clear
    .[K1:K2].Value = [{"Colonne B";"chir*"}]
               RC& = .Rows.Count
End With

For N% = 1 To 3
    With Worksheets(N).[B2].CurrentRegion
        .AdvancedFilter xlFilterInPlace, Feuil4.[K1:K2]
        .Columns("A:B").Offset(1).Copy Feuil4.Cells(RC, 2).End(xlUp)(2)
        .Parent.ShowAllData
    End With
Next
End Sub

Bonjour,

En complément du code de Marc L, pour les filtres couleur.

Cdlt

For N = 1 To 3
        With Worksheets(N).[B2].CurrentRegion
            .AutoFilter field:=3, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            If Not .Range("_FilterDataBase") Is Nothing Then _
                    .Range("_FilterDataBase").Copy Feuil4.Cells(RC, 5).End(xlUp)(2)
            .AutoFilter
        End With
    Next

Bonjour,

Merci pour vos deux réponses. Cela m'a bien aidé à avancer !

En revanche, j'ai essayé de l'adapter à mon vrai classeur et la compilation me donne le message suiavnt :

"Référence incorrecte ou non qualifiée"

Pouvez-vous regarder le code ci-dessous que j'ai annoté et me dire si vous voyez quelque chose bizarre ?

Merci beaucoup,

waxscud

Sub Test()

    Application.ScreenUpdating = False

    Dim Filtre, X As Worksheet

    With ActiveSheet   'Je lance la macro depuis mon onglet d'affichage des filtre avancés (Nom de l'onglet = Filtre)
        .[A8].CurrentRegion.Offset(1).Clear  'Dans mon onglet filtre, mon tableau de résultat a son entête entre A8 et AB8
        RC% = .Rows.Count 'J'imagine que cela compte le nombre de lignes renseignées sous l'entête
    End With

    For Each X In Sheets
        If (X.Name Like "*CHIR*" Or X.Name Like "*DOCT*") Then   'Je ne veux appliquer la macro que sur les onglets répondant à ces critères
            X.[A1].CurrentRegion   'Dans mes onglets de données, l'entête est sur la ligne 1
            .AdvancedFilter xlFilterInPlace, Filtre.[X2:X3]     'Ma zone de critère est en X2:X3 dans l'onglet Filtre.
            .Columns("A:AB").Offset(1).Copy Filtre.Cells(RC, 0).End(xlUp)(2)  'Là je ne suis pas sûr de tout piger :)
            .Parent.ShowAllData
        End If
    Next
End Sub

Comme indiqué par le message, la variable Filtre n'est pas initialisée …

Bonjour Marc,

Merci pour ta réponse. je pense qu'il s'agissait 'un problème de déclaration effectivement.

En passant par le numéro de la feuille, je pense avoir soldé le problème.

Néanmoins, le compilateur est toujours grincheux et pour le code ci-dessous j'obtiens une erreur sur la ligne

".Columns("A:AB").Offset(1).Copy Feuil25.Cells(RC, 0).End(xlUp)(2) " => Erreur définir par l'application ou par l'objet.

Pour rappel, dans ma feuille d'arrivée, la ligne d'en tête est en ligne 8 (ce qui pose peut-être problème).

Merci encore pour votre temps et votre aide...

waxscud

Sub Filtrefae()

    Application.ScreenUpdating = False
    Dim X As Worksheet

    With Feuil25
        .[A8].CurrentRegion.Offset(1).Clear
        RC& = .Rows.Count
    End With

    For Each X In Worksheets
        If (X.Name Like "*CHIR*" Or X.Name Like "*DOCT*") Then
            With X.[A1].CurrentRegion
                .AdvancedFilter xlFilterInPlace, Feuil25.[X2:X3]
                .Columns("A:AB").Offset(1).Copy Feuil25.Cells(RC, 0).End(xlUp)(2)
                .Parent.ShowAllData
            End With
        End If
    Next
End Sub

Au sein de la propriété Cells, ni ligne ni colonne peuvent être égales à zéro !

Bonjour,

Marc, déjà encore merci. Tu me permets d'avancer considérablement.

J'ai presque fini.

Je suis face à, je pense, à une dernière problématique liée aux filtres élaborés issus de différents onglets : les filtres sur des critères calculés.

En effet si mes zones de critères testent une valeur ou un texte, aucun souci.

En revanche si je veux tester une formule, cela devient complexe.

Par exemple si je veux récupérer les lignes en testant que la valeur en colonne F soit inférieure à la valeur en colonne E.

Je dois choisir des cellules pour effectuer pour effectuer mon test logique. Mais sur quelle feuille ?

Si ma zone de critère est :

TEST1

='Feuil1'!F2<'Feuil1'!E2 (Test qui me donne VRAI)

Alors le filtre fonctionne correctement pour la feuille 1 mais pas pour les autres onglets...

Y a-t-il un moyen pour contourner cela ?

Merci encore !

waxscud

A chaque itération de la boucle, la formule doit être mise à jour en utilisant le nom de la feuille via X.Name

Marc,

Pas évident comme mise à jour... :S

Quelque chose comme ça peut marcher ? Je n'en ai pas l'impression...

Je ne dois plus être très loin

Merci,

waxscud

For Each X In Worksheets
        If (X.Name Like "*CHIR*" Or X.Name Like "*DOCT*") Then
            With X.[A1].CurrentRegion
                    Set Feuil25.Cells(3, 12) = "=X.name!M2<>X.name!L2" 'Test pour changement d'onglet dans la formule de test
                    .AdvancedFilter xlFilterInPlace, Feuil25.[L2:M3]
                    .Columns("A:AB").Offset(1).Copy Feuil25.Cells(RC, 1).End(xlUp)(2)
                    .Parent.ShowAllData
            End With
        End If
 Next

Ne pas confondre texte et variable ! X étant une variable, ne peut pas être entre guillemets !

"=X.name!M2<>X.name!L2" : tout ce qui est entre guillemets est donc du texte, résultat identique !

Tandis que "=" & X.name & "!M2<>" & X.name & "!L2"

Autre méthode : utiliser un caractère particulier dans la formule et via la fonction Replace lui substituer le nom de la feuille …

Je n'y parviens pas...

Je vais marquer le sujet comme résolu pour l'aide précieuse qui m'a été apporté.

J'essaierai de me pencher sur les autres problèmes dans un autre sujet.

Encore merci pour tout Marc !

Bonne fin de journée,

waxscud

Je n'avais pas vu mais le Set est de trop ! Consulter l'aide VBA pour voir son utilité !

Et puis pour une formule il ne faut pas oublier de préciser la propriété Formula

Décrire en un français limpide de quoi il s'agit exactement devrait aider à obtenir une solution, si, si !

Marc,

Je suis désolé, je suis peut-être trop peu imprécis avec ce que je veux.

Si je fais le bilan : la macro pour laquelle vous m'avez aidé me permet d'utiliser les filtres élaborés sur plusieurs tableaux en même temps. Les critères de recherche simple de type "Colonne A = 0 ou Colonne B contient "Chir" fonctionnent à merveille.

Cela se complique lorsque le critère implique une formule car la formule doit être remplacée à chaque itération de la boucle (dès que la boucle passe au tableau (à l'onglet) suivant.

Je cherche alors à trouver comment faire appel à l'onglet actif dans la boucle dans la formule de mon critère de recherche.

En effectuant ce code, je n'arrive à rien...

Please help once again

merci,

waxscud

Sub Filtre()

    Dim X As Worksheet

    With Feuil25
        .[A9].CurrentRegion.Offset(1).Clear
        RC& = .Rows.Count
    End With

    For Each X In Worksheets
        If (X.Name Like "*CHIR*" Or X.Name Like "*DOCT*") Then
            With X.[A1].CurrentRegion
                    ThisWorkbook.Worksheets("Filtre").Range("L3").Formula = "="X.range("M2)"<>"X.range("L2")"
                    .AdvancedFilter xlFilterInPlace, Feuil25.[L2:M3]
                    .Columns("A:AB").Offset(1).Copy Feuil25.Cells(RC, 1).End(xlUp)(2)
                    On Error Resume Next
                    .Parent.ShowAllData
                    On Error GoTo 0
            End With
        End If
    Next
End Sub

Disons que je lis aussi en diagonale …

En manuel, dans la feuille de calculs, quelle est la formule exacte du critère calculé, ='Feuil1'!F2<'Feuil1'!E2 ?

Rechercher des sujets similaires à "creation liste criteres donnees multi feuilles"