sauvegarde Portefeuille1.xlsm (26,6 Ko)
le projet est le suivant: je ne sais pas s’il faut le détailler (excusez la longueur du texte)
Nom de la macro FiltrerDonnees
Nom du classeur : « sauvegarde Portefeuille1.xlsm ».
Contient 2 feuilles de calcul appelées « contrats » et « résultats »
Chaque ouverture du classeur devra s’effectuer sur la feuille « contrats »
Dans la feuille de calcul : « contrats » on utilise un nombre illimité de cellules avec un nombre illimité de colonnes et de lignes.
La ligne numéro 1 permet d’attribuer un titre à chaque colonne.
Rôle de la macro
La macro devra filtrer des critères qui correspondent à des données présentes dans n’importe quelle cellule de la feuille "contrats » contenant des données. Ce pourront être des nombres, des dates, des textes, etc
Sélection des critères de filtre
Au lancement de la macro, une msgbox numéro 1 demande de définir en les écrivant dans la fenêtre de la même msgbox, tous les critères à filtrer existant dans la feuille « contrats », sans limite de nombre, sans casse particulière, de tous formats et séparés les uns des autres par une virgule. Le texte de la msgbox N°1 indiquera : «Inscrivez dans la fenêtre tous les critères que vous souhaitez filtrer en les séparant par une virgule »
Validation de la sélection par un bouton OK dans la même msgbox
Choix de la logique du filtre
Le fait de cliquer sur OK fait apparaitre une deuxième msgbox n°2 concernant le choix entre "et » et « ou » dans laquelle il y a 2 boutons
Intitulé des boutons : (« oui » et « non » ou si cela est possible un bouton « et » et un bouton « ou »).
Un texte explique : "en choisissant « oui » (ou « et ») le filtre sélectionnera uniquement les lignes dans lesquelles la totalité des critères sollicités seront présents simultanément, tandis qu’en choisissant « non » (ou « ou ») le filtre sélectionnera toutes les lignes dans lesquelles au minimum un critère sollicité sera présent.
déroulement du filtre en cas de réponse « oui » (« et »),
Si au moins une ligne contient la totalité des critères recherchés :
-copie de toutes ces lignes contenant la totalité des critères inscrits dans la msgbox 1
- si l’action aboutit à la copie d’au moins une ligne, une msgbox n° 4 affichera le message « copie réussie ».
- une fois la copie des lignes sélectionnées dans la feuille "contrats » effectuée,
- ouverture de la feuille du classeur nommée « résultats »
- effacement des données qu’elle contient s’il y en a, afin que la totalité des cellules de la feuille résultats soit vide.
- collage sur la feuille « résultats », des lignes sélectionnées et copiées par le filtre dans la feuille « contrats » en commençant à la cellule A1
- si des lignes contenant les paramètres recherchés sont collées dans la feuille « résultats » une message box n°5 indiquera "filtrage réussi», ce qui induira un retour à la feuille « contrats » par un bouton OK
si aucune ligne ne contient la totalité des critères recherchés une msgbox n°6 affichera le message: "il n’y a pas de données correspondant à votre recherche" et proposera un bouton "retour à la feuille « contrats ».
- retour à la feuille « contrats » si ce bouton est activé
- aucune ligne ne sera copiée
déroulement du filtre en cas de réponse « non » (« ou »), le modèle ci-dessus est repris de façon identique avec les différences logiques liées au choix.
Pour que vous ne pensiez pas que je nai pas essayé…Voici ce que j’ai écrit mais sans résultat 
Sub FiltrerDonnees()
Dim val As String
Dim valeurs() As String
Dim i As Long
Dim criteres() As String
Dim lastRow As Long
Dim filteredSheet As Worksheet
Dim choix As Integer
Dim filtreEt As Boolean
val = InputBox("Entrez les valeurs à filtrer, séparées par des virgules", "Filtrer les données")
If val = "" Then
Exit Sub
End If
choix = MsgBox("Voulez-vous rechercher les valeurs avec la logique 'et' (bouton Oui) ou la logique 'ou' (bouton Non) ?", vbQuestion + vbYesNo, "Filtrer les données")
If choix = vbYes Then
filtreEt = True
Else
filtreEt = False
End If
valeurs = Split(val, ",")
ReDim criteres(UBound(valeurs))
For i = 0 To UBound(valeurs)
criteres(i) = "(*" & UCase(CStr(valeurs(i))) & "*)"
Next i
' Effacer les filtres existants
If ActiveSheet.AutoFilterMode = True Then
ActiveSheet.AutoFilterMode = False
End If
' Filtrer les données
Dim contratsSheet As Worksheet ' Définit la feuille "contrats" comme feuille de travail active
Set contratsSheet = Nothing
On Error Resume Next
Set contratsSheet = ThisWorkbook.Sheets(« contrats »)
On Error GoTo 0
If contratsSheet Is Nothing Then
MsgBox « La feuille de calcul « « contrats » » n’a pas été trouvée. »
Else
criteres = Array(« Critère 1 », « Critère 2 », « Critère 3 ») ’ Exemple de critères de filtrage
lastRow = contratsSheet.Cells(Rows.Count, 1).End(xlUp).Row ’ Détermine la dernière ligne contenant des données dans la colonne A
contratsSheet.Range(« A1 », contratsSheet.Cells(lastRow, contratsSheet.Columns.Count)).AutoFilter Field:=1, Criteria1:=criteres, Operator:=xlFilterValues ’ Filtre les données en utilisant les critères de filtrage
End If
' Copier les résultats filtrés dans une nouvelle feuille
Set filteredSheet = ThisWorkbook.Sheets("Resultats")
If Not filteredSheet Is Nothing Then
filteredSheet.Cells.Clear
Else
Set filteredSheet = ThisWorkbook.Sheets.Add(After:=ActiveSheet)
filteredSheet.Name = "Resultats"
End If
lastRow = contratsSheet.Cells(contratsSheet.Rows.Count, 1).End(xlUp).Row
contratsSheet.Range("A1", contratsSheet.Cells(lastRow, contratsSheet.Columns.Count)).SpecialCells(xlCellTypeVisible).EntireRow.Copy filteredSheet.Range("A1")
' Ajuster la largeur des colonnes dans la nouvelle feuille
filteredSheet.Columns.AutoFit
' Désactiver le filtre
ThisWorkbook.ActiveSheet.AutoFilterMode = False
End Sub
