Filtre élaboré dynamique

[yoyobat]

Bonjour à tous,

Je cherche à crée un filtre élaboré dynamique.
Mon objectif est de à partir d'une "bibliothèque" recensant des produits, je puisse selon des critères définis dans la bibliothèque retrouvé mes produits.
J'explique mieux:
- j'ai créer une feuille "bibliothèque" recensant tous mes produits avec leur caractéristiques (ex:fondations)
- j'ai créer une feuille "critères" où je voudrais rentrer à la main des critères correspondants à mes produits (ex: sans vibration)
- j'ai créer une feuille "résultats" ou je veux qu'en fonction de mes critères rentrés, il me donne la liste de mes produits répondants à ces critères.

J'ai pu créer le code suivant (module1) mais il y a un problème avec le "CopyToRange".

Option Explicit
Sub Filtrer()
Application.ScreenUpdating = False
Call Nettoyer
Range("Input").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("Criteria"), _
CopyToRange:=Range("Extract")
Application.ScreenUpdating = True
End Sub
Private Sub Nettoyer()
With Feuil3.Range("A2😛300")
.ClearContents
End With
End Sub

Quelqu'un peut me dire quel est ce problème?

Merci beaucoup.

Yoyobat

 

[Guest]

Re : Filtre élaboré dynamique

Bonjour,

Il ne te restait plus qu'à désigner les feuilles Source, Destination, Critères:

Sub Filtrer()
    Application.ScreenUpdating = False
    Call Nettoyer
    Sheets("Bibliothèque").Range("Input").AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("Critères").Range("Critères"), _
            CopyToRange:=Sheets("Résultats").Range("Extract")
    Application.ScreenUpdating = True
End Sub

A+

 

[yoyobat]

Re : Filtre élaboré dynamique

Ah oui c'est super ça marche parfaitement.
Merci beaucoup

Par contre (et cela serait le petit plus)

Lors de la sélection d'un premier critère ça m'affiche une liste de produits (OK)
Lorsque je réduis ma liste de produits avec un second critère ma liste se réduit (OK) mais il reste la mise en forme des anciens produits selctionnés avec le premier critère (notamment la couleur et les bordures).

Je voudrais donc effacer cette mise en forme est-ce possible?
Ou alors directement supprimer les lignes entièrement vides.

J'ai pu faire rapidement ce code mais ça me les supprime toutes.

Sub SuppLigneVides()
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

Pourrais-tu me guider stp?

Merci encore.

Yoyobat

 

[Guest]

Re : Filtre élaboré dynamique

Bonjour,

Sub MiseEnFormeResultats()
    Dim lg As Long
    Dim derlig As Long
    derlig = Sheets("Résultats").Range("A" & Rows.Count).End(xlUp).Row
    If derlig > 1 Then
        With Sheets("Résultats").Range("A2:A" & derlig)
            If .Rows.Count > 1 Then
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = xlNone
                    .Cells.Borders.LineStyle = xlLineStyleNone
                    For lg = .Rows.Count To 1 Step -1
                        Debug.Print .Rows(lg).Row
                        If Application.CountA(.Rows(lg)) = 0 Then .Rows(lg).Delete xlShiftUp
                    Next
                End With
            End If
        End With
    End If
End Sub

A+