XL 2016 Filtré selon critères de sélection dans plusieurs feuilles d'un classeur

[walter ebelle]

Bonjour à tous les membres du forum,
Je souhaite l’aide de tous pour une solution à ma préoccupation.
1; je veux sur une feuille vierge du même classeur, faire la sélection de toutes les lignes dans chaque feuille et pour toutes les feuilles du classeur ayant des lignes aux critères de sélection suivant :
COLONNE AB (27A28) VRAI
COLONNE KY (Pre17) FAUX
COLONNE LL (Nbre 5 A) inferieur ou égale à 1
COLONNE LM (Nbre 5 B) = 0
COLONNE MT (Nbre domiA) Supérieur à 7
COLONNE MV (9) égale 8
COLONNE MW (CR domi) FAUX
COLONNE MX (CR Ext) FAUX
Comment faire une telle sélection et comment l’appel-t-on.

 

[Rouge]

Bonjour,

Proposition:
On ajoute une colonne supplémentaire en fin de tableau de chaque feuille avec une formule qui reprend toutes les conditions, si celles-ci sont toutes réunies alors un met un "X" sur la ligne correspondante sinon rien.
Ensuite on filtre sur cette colonne et on ne conserve que les lignes comportant un" X" et le tout est recopié dans la feuille "Synthèse". Tout ceci est fait automatiquement via une macro activée par le bouton "SYNTHESE" situé dans la feuille de même nom.
Pour les exemples que vous avez mis, sauf erreur de ma part, il n'y a aucune ligne qui réponde à tous ces critères, donc la feuille "Synthèse" reste vide.

le code

Sub Synthese()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long, i  As Long
    Dim NbLig As Long, NbCol As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Synthese")
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "Synthese" Then
            Set f2 = Sheets(Sheets(i).Name) 'feuille traitée
            f2.Range("NI1") = "Solutions"
            NbCol = f2.[XFD1].End(xlToLeft).Column 'Dernière colonne de la feuille 2
            f2.AutoFilterMode = False 'suppression des filtres existants
            f2.Range(f2.Cells(1, "A"), f2.Cells(1, NbCol + 1)).AutoFilter 'Ajout du filtre
            DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row ' Dernière ligne de la feuille traitée
            'Forçage de la syntaxe des formules dans les cellules suivantes
            f2.Range("AB2:AB" & DerLig_f2).FormulaR1C1 = "=IF(RC[-6]<RC[-5],""VRAI"",""FAUX"")"
            f2.Range("KY2:KY" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC[-1]>=RC[-3],RC[-1]>RC[-5]),""VRAI"",""FAUX"")"
            f2.Range("MW2:MW" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC[-3]>RC[-2],RC[-359]<RC[-358]),""CR"",""FAUX"")"
            f2.Range("MX2:MX" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC[-4]<RC[-3],RC[-360]>RC[-359]),""CR"",""FAUX"")"
            'Ajout d'une colonne supplémentaire avec une formule qui reprend toutes les conditions requises
            f2.Range("NI2:NI" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC28=""VRAI"",RC311=""FAUX"",RC324<=1,RC325=0,RC358>7,RC360=8,RC361=""FAUX"",RC362=""FAUX""),""X"","""")"
            f2.Range("A1:NI" & DerLig_f2).AutoFilter Field:=NbCol, Criteria1:="X" 'filtre sur cette colonne à la recherche des "X"
            NbLig = f2.Range("_FilterDataBase").Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1 ' nombre de lignes restantes après filtrage
            'Récupération de la zone filtrée et copie dans la feuille 1
            DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne de la feuille synthèse
            f2.Range("_FilterDataBase").Offset(1, 0).Resize(, NbCol).SpecialCells(xlCellTypeVisible).Copy Destination:=f1.Range("B" & DerLig_f1 + 1)
            If NbLig > 0 Then Range(f1.Cells(DerLig_f1 + 1, "A"), f1.Cells(DerLig_f1 + NbLig, "A")) = Sheets(i).Name 'ajout du nom de la feuille en colonne A
            f2.AutoFilterMode = False 'Suppression des filtres de la feuille traitée
        End If
    Next i
    
    f1.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

J'ai supprimé des lignes dans les tableaux pour pouvoir joindre le fichier trop volumineux.
Cdlt

 

[walter ebelle]

Bonjour,

Proposition:
On ajoute une colonne supplémentaire en fin de tableau de chaque feuille avec une formule qui reprend toutes les conditions, si celles-ci sont toutes réunies alors un met un "X" sur la ligne correspondante sinon rien.
Ensuite on filtre sur cette colonne et on ne conserve que les lignes comportant un" X" et le tout est recopié dans la feuille "Synthèse". Tout ceci est fait automatiquement via une macro activée par le bouton "SYNTHESE" situé dans la feuille de même nom.
Pour les exemples que vous avez mis, sauf erreur de ma part, il n'y a aucune ligne qui réponde à tous ces critères, donc la feuille "Synthèse" reste vide.

le code

Sub Synthese()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long, i  As Long
    Dim NbLig As Long, NbCol As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Synthese")
   
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "Synthese" Then
            Set f2 = Sheets(Sheets(i).Name) 'feuille traitée
            f2.Range("NI1") = "Solutions"
            NbCol = f2.[XFD1].End(xlToLeft).Column 'Dernière colonne de la feuille 2
            f2.AutoFilterMode = False 'suppression des filtres existants
            f2.Range(f2.Cells(1, "A"), f2.Cells(1, NbCol + 1)).AutoFilter 'Ajout du filtre
            DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row ' Dernière ligne de la feuille traitée
            'Forçage de la syntaxe des formules dans les cellules suivantes
            f2.Range("AB2:AB" & DerLig_f2).FormulaR1C1 = "=IF(RC[-6]<RC[-5],""VRAI"",""FAUX"")"
            f2.Range("KY2:KY" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC[-1]>=RC[-3],RC[-1]>RC[-5]),""VRAI"",""FAUX"")"
            f2.Range("MW2:MW" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC[-3]>RC[-2],RC[-359]<RC[-358]),""CR"",""FAUX"")"
            f2.Range("MX2:MX" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC[-4]<RC[-3],RC[-360]>RC[-359]),""CR"",""FAUX"")"
            'Ajout d'une colonne supplémentaire avec une formule qui reprend toutes les conditions requises
            f2.Range("NI2:NI" & DerLig_f2).FormulaR1C1 = "=IF(AND(RC28=""VRAI"",RC311=""FAUX"",RC324<=1,RC325=0,RC358>7,RC360=8,RC361=""FAUX"",RC362=""FAUX""),""X"","""")"
            f2.Range("A1:NI" & DerLig_f2).AutoFilter Field:=NbCol, Criteria1:="X" 'filtre sur cette colonne à la recherche des "X"
            NbLig = f2.Range("_FilterDataBase").Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1 ' nombre de lignes restantes après filtrage
            'Récupération de la zone filtrée et copie dans la feuille 1
            DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne de la feuille synthèse
            f2.Range("_FilterDataBase").Offset(1, 0).Resize(, NbCol).SpecialCells(xlCellTypeVisible).Copy Destination:=f1.Range("B" & DerLig_f1 + 1)
            If NbLig > 0 Then Range(f1.Cells(DerLig_f1 + 1, "A"), f1.Cells(DerLig_f1 + NbLig, "A")) = Sheets(i).Name 'ajout du nom de la feuille en colonne A
            f2.AutoFilterMode = False 'Suppression des filtres de la feuille traitée
        End If
    Next i
   
    f1.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

J'ai supprimé des lignes dans les tableaux pour pouvoir joindre le fichier trop volumineux.
Cdlt

Bonjour Rouge,
Merci d'avoir réagi par cette proposition. Ce qui me préoccupe c'est le nombre très important de feuilles du classeur original avec les même tableaux dans lesquels il faudra ajouter une colonne. Après faire le filtre de X.
1*Est-ilpossible de sélectionner toutes les feuilles du classeur avec une formule et d'ajouter de façon automatique la ligne supplémentaire contenant la formule ?
2* soit ajouter la colonne en y mettant la formule dans une seule feuille et copier de façon automatique sur tous les tableaux du classeur en sélectionnant les onglets

 

[Rouge]

J'ai écrit plus haut
Tout ceci est fait automatiquement via une macro activée par le bouton "SYNTHESE" situé dans la feuille de même nom.