Microsoft 365 Filtre avancé VBA multi-critères

DELHOMME · 2 Novembre 2024

Bonjour,

Je souhaite réaliser en vba un filtre avancé (élaboré) en VBA multi-critères
- à partir d'un tableau de données (onglet "Source")
- à partir d'une plage de critères ("A02:AQ24") que je trouverais dans chaque onglet crée (S41, S42...etc.. correspondant à une extraction hebdomadaire)
- et dont le résultat de l'extraction ("BT2: DB2") se localise sur chaque onglet.
Je réalise actuellement cette opération "manuellement" par le filtre et cela fonctionne très bien.
Je souhaite maintenant automatisé tout cela avec un bouton d'action permettant de lancer une macro et un bouton effacer.

J'ai crée un onglet "essais" (qui correspondra aux futurs onglets S41, S42... etc) pour tester la macro suivante que je nomme "ExtraireFiltre" et que j'ai mis dans le module 1

VB:

Sub ExtraireFiltre()
Dim Criteres As Range
Set Criteres = Range("A02:AQ24") 'définition plage critères
'On applique le filtre avancé
Sheets("Source").Range("A2:CJ3705").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Criteres, _
    CopyToRange:=Range("BT2:DB2"), _
    Unique:=False
Range("BS1").Select
End Sub

Malheureusement rien ne se passe. Aucun résultat (sauf le range sur BS1...), aucun bug !!

J'ai testé parallèlement l'autre macro "EffaceData" et celle-ci fonctionne bien.

Je joins un fichier simplifié (onglets "Source" et "essais")... le fichier original est trop volumineux !!

Merci pour vos lumières...

Bien à vous

DELHOMME · 3 Novembre 2024

Bonjour au fil,
Au final, pour réaliser ce filtre, j'ai concentré dans une seule cellule toutes les formules entrant comme conditions dans la plage des critères.
Regarde la pièce jointe 1206387
L'avantage est de concentrer toutes les conditions dans une simple fonction logique ET.

J'ai réalisé ensuite une macro très simple avec comme plage de critères la cellule comportant les critères des différents filtres.

VB:

Sub BaseFilter()

Sheets("Source").Range("A2:CJ8000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("AO11:AO12"), CopyToRange:=Range("BT2:DB2"), Unique:=False
Range("AQ9").Select

End Sub

Merci encore pour vos éclairages.

vgendron · 2 Novembre 2024

Hello

à priori, le résultat du filtre avancé ne peut pas être directement copié sur une autre feuille que la source
en manuel, il me refuse de copier le résultat du filtre ailleurs que dans la feuille "Source"

DELHOMME · 2 Novembre 2024

Hello,
Merci à toi pour ton retour.
je n'ai pas le problème en manuel (le résultat est bien copié dans l'onglet "essais")... l'action "xlFilterCopy" fait bien son taff.
En passant par VBA, j'avoue que je ne sais pas car je n'ai rien du tout (l'objet de mon message...)

vgendron · 2 Novembre 2024

moi je ne suis pas sur la meme version excel que toi..peut etre une évolution de la version 365

j'imagine que ton code vient de l'enregistreur de macro..
est ce que tu as bien repris les plages avec ou sans entêtes?
et est ce que il y a au moins une ligne à filtrer?

DELHOMME · 2 Novembre 2024

"peut etre une évolution de la version 365" - aie ! si c'est ça, ça promet pour la compatibilité
"j'imagine que ton code vient de l'enregistreur de macro.." - non, je l'ai ecrit mais bon je ne suis pas un expert, il n'est peut-être pas bon
"est ce que tu as bien repris les plages avec ou sans entêtes?" - ça oui avec entêtes
"et est ce que il y a au moins une ligne à filtrer?" - sur la source c'est plus de 700 lignes (à moins que je n'ai pas bien compris ta question...)

vgendron · 2 Novembre 2024

refais ton filtre avec l'enregistreur de macro==> tu verras ce qui est exactement codé, et comment

la dernière question portait sur le résultat du filtre..
tu as bien une source de 700 lignes, mais est ce que ton filtre est censé donner au moins une ligne de résultat..

DELHOMME · 2 Novembre 2024

OK - pour le résultat - je dois avoir 70 lignes (réponses) - je viens de le faire en manuel et pour l'enregistrement de la macro
J'ai refais mon filtre ("ExtraireFiltreNew") avec l'enregistreur de macro. J'ai cleané les scroll. Il se trouve dans le module 2 (ci-dessous)

VB:

Sub ExtraireFiltreNew()
'
' ExtraireFiltreNew Macro
'

    Sheets("Source").Range("TableauSource[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("AO2:AQ24"), CopyToRange:=Range( _
        "BT2:DB2"), Unique:=False

End Sub

J'ai effacé les données avec ma macro "Effacedata" - Nickel.
J'ai lancé la nouvelle macro - Rien...

DELHOMME · 2 Novembre 2024

je joins le fichier... c'est peut-être mieux pour suivre !

vgendron · 2 Novembre 2024

je t'avoue que je ne vois pas..
peut etre une histoire d'interprétation de la plage de critère qui contient des formules..?
quand tu le fais à la main, excel voit bien les critères
par VBA il ne voit que des formules??

DELHOMME · 2 Novembre 2024

hum... très judicieux ta remarque.
j'ai testé la macro avec un seul critère (qui ne contient pas de formule) et effectivement ça marche.
La piste - "pas de formule dans les cellules de la plage de critère avec de la VBA sur un filtre avancé" semble être la bonne...
Je vais voir comment adapter les filtres sur les dates. (2 autofiltrer imbriqués ?.... je vais tester tout ça...)
J'enverrais un petit message avant de clotûrer la discussion
Merci en tout cas pour le temps que tu m'as consacré.
Bien à toi

ChTi160 · 2 Novembre 2024

Bonjour le Fil
ceux ci semble fonctionner

VB:

Sub FiltrerEtCopier()

    Dim Ws_Source As Worksheet
    Dim Ws_Destination As Worksheet
    Dim TabSource As Range
    Dim CritRange As Range
    Dim CopyToRange As Range

    ' Définir les feuilles de calcul
    Set Ws_Source = ThisWorkbook.Sheets("Source")
    Set Ws_Destination = ThisWorkbook.Sheets("essais") ' Assurez-vous que cette feuille existe

    ' Définir la plage du tableau source
    Set TabSource = Ws_Source.Range("TableauSource[#All]")

    ' Définir la plage de critères
    Set CritRange = Ws_Source.Range("AO2:AQ24")

    ' Définir la plage de destination où les résultats seront copiés
    Set CopyToRange = Ws_Destination.Range("BT2:DB2") ' Assurez-vous que cette plage est correcte

    ' Appliquer le filtre avancé
    TabSource.AdvancedFilter Action:=xlFilterCopy, _
                                  criteriaRange:=criteriaRange, _
                                  CopyToRange:=CopyToRange, _
                                  Unique:=False
End Sub

Bonne fin de Journée
Jean marie

vgendron · 2 Novembre 2024

Hello Jean Marie

une correction à apporter dans ton filtre
CriteriaRange:=CritRange

vgendron · 2 Novembre 2024

Sinon.. j'en déduis que utiliser un filtre avancé en VBA, il faut que tous les éléments (CriteriaRange, Copytorange) soient définis au préalable
un peu comme un dico qui n'aime pas qu'on lui demande d'évaluer une clé dans la meme instruction où on lui demande de tester son existance..

DELHOMME · 2 Novembre 2024

Hello à tous les deux,

J'ai testé le code de Jean-marie avec la modif (CriteriaRange)... rien dans le résultat.
Il y a la piste - pas de formule dans les cellules de la plage des critères - je vais tester tout ça !
Merci à vous.

DELHOMME · 3 Novembre 2024

Bonjour au fil,
Au final, pour réaliser ce filtre, j'ai concentré dans une seule cellule toutes les formules entrant comme conditions dans la plage des critères.
Regarde la pièce jointe 1206387
L'avantage est de concentrer toutes les conditions dans une simple fonction logique ET.

J'ai réalisé ensuite une macro très simple avec comme plage de critères la cellule comportant les critères des différents filtres.

VB:

Sub BaseFilter()

Sheets("Source").Range("A2:CJ8000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("AO11:AO12"), CopyToRange:=Range("BT2:DB2"), Unique:=False
Range("AQ9").Select

End Sub

Merci encore pour vos éclairages.

Microsoft 365 Filtre avancé VBA multi-critères

DELHOMME

XLDnaute Nouveau

Pièces jointes

DELHOMME

vgendron

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

DELHOMME

XLDnaute Nouveau

Pièces jointes

vgendron

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

ChTi160

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

DELHOMME

XLDnaute Nouveau

Pièces jointes

Discussions similaires