Probleme pour duppliquer code fonction filtrer / menu deroulant
Bonjour à tous,
J'ai un probleme avec le fichier qui apparait en pièce jointe.
Je n'arrive pas à dupliquer tout ce qui est fait dans l'onglet "ARA" avec en particulier la fonction filtrer, sur les autres onglets. J'ai tenté de le faire sur l'onglet "HARNAIS" mais en vain, ce sont toujours les infos de l'onglet "ARA" qui apparaissent..
J'ai fais un copier/coller du code de l'onglet "ARA" dans celui de l'onglet "HARNAIS", j'ai changé des petites choses et cela ne fonctionne pas.
Idem, dans le module , qui est le module filtrer, ça ne va pas, je n'arrive pas à rajouter un filtre uniquement pour l'onglet "HARNAIS" , indépendamment de l'onglet "ARA". Bref, je ne comprends pas comment je peux faire. Tout ce que je cherche à faire c'est à dupliquer sur les autres onglets ce qui fonctionne bien. Et cela me permettrai de finir mon projet.
Je remets le fichier à jour avec le code que j'ai essayé de mettre, voir en pièce jointe.
Merci d'avance pour vos retours.
Bonjour,
J'ai tenté de le faire sur l'onglet "HARNAIS", mais en vain, ce sont toujours les infos de l'onglet "ARA" qui apparaissent..
Va dans le "Gestionnaire de noms" (menu Formules > Gestionnaire de noms).
Tu vas y remarquer que les zones 1 à 10 ont une Étendue "Classeur".
Dans le code que tu as dupliqué dans dans feuille "Harnais", tu fais encore référence aux mêmes zones (de la feuille ARA)... d'où le problème.
Si j'ai bien compris les fonctionnements car, je n'ai regardé qu'en diagonale...
-- Si les tableaux des deux feuilles sont identiques ...
Il faudrait que tu changes les champs nommés pour que l'étendue ne soit que pour la feuille ARA.
Tu pourras, dès lors, créer de nouveaux champs nommés avec les mêmes noms, mais pour l'étendue de la feuille Harnais.
Il ne restera dans le code qu'à t'assurer de pointer sur la bonne feuille (onglet).
-- Si les tableaux des deux feuilles ne sont pas identiques ...
Tu crées de nouveaux noms, exemple : zoneHarnais1 à zoneHarnais10 et modifie le code de la feuille Harnais.
ric
Bonjour Ric,
Merci pour ton aide.
Effectivement, je vois que le problème doit venir des noms.
J'ai donc suivi ta deuxieme méthode, car les tableaux des 2 feuilles ne sont pas identiques.
J'ai donc nommés les champs différements et dans le code, j'ai remplacé [Tabdata].valaue par [TabDataHarnais].value. Et j'ai renommé le tableau de l'onglet harnais en TabDateHarnais.
Mais cela ne fonctionne toujours pas ....
As tu une idée stp, merci d'avance. Je remets le fichier modifié en pièce jointe.
Encore merci.
Ric,
Il y a encore 2-3 trucs que j'ai vu, j'ai remodifié les plages etc ... mais cela ne fonctionne toujours pas ....
Et il y a une erreur dans le filtre que je ne comprends pas ...
Merci de ton aide, je remets le fichier modifier en pièce jointe :
Bonjour,
Effectivement, il y avait 2 ou 3 trucs.
Feuille BdDHarnais n'était pas un tableau, mais une simple plage = Corrigé
Où j'ai cherché longtemps, les noms d'entêtes de la feuille Harnais et BdDHarnais n'étaient pas exactement les mêmes, ce qui empêchait le filtre de fonctionner.
Les noms de zones : zoneharnais1 et non zone1harnais = Corrigé
J'ai renommé le tableau TabData en TabDataARA et créé TabDataHarnais (j'ai dû effacer le champ nommé, car, il se crée avec le tableau.
J'ai aussi modifié les champs nommés Critères et Extraire pour la feuille Harnais.
Il ne te restera qu'à reproduire pour les autres items.
Ouppsss! avant de terminer, le tableau TabDataARA se rend à la ligne 3898 ... aussi loin, est-ce nécessaire ?
Pour redimensionner au besoin, clique dans le tableau, clique sur Création dans le menu en haut, puis, Redimensionner le tableau (sous son nom).
Je reste à l'écoute.
ric
Ric,
T'es un chef !!
Je ne sais pas quoi te dire. Tout fonctionne parfaitement.
Donc ca fait 20 min que j'ai repris l'ancien fichier et que je refais tout moi même pour bien comprendre ce que tu as fais et afin que je puisses le reproduire moi même pour les autres onglets.
Ca fonctionne plutôt bien, sauf au dernier moment, lorsque je clique sur filtrer ! il me dit que la macro n'existe pas ou quelle est pas activée.
Et deuxième chose que je n'arrive pas à reproduire, c'est dans l'onglet BdDHarnais, toute ma ligne 2 s'est transformée en colonne que je ne peux pas supprimer. Tu expliques cela comment ?
Je pense que lorsque j'aurai compris ces derniers éléments, je saurais me débrouiller seul. En tout cas j'ai beaucoup appris grâce à toi et il y a déjà plein de chose qui sont beaucoup plus clair.
Merci.
Bonjour,
Les deux irritants ont la même source, c'est-à-dire que le TabDataHarnais commence à la ligne 3 (l'entête en ligne 2).
J'ai donc supprimé la ligne1 et recopier les entêtes se la feuille Harnais sur la feuille BdDHarnais.
Cela a corrigé l'emplacement du tableau et le filtre s'est mis à fonctionner.
Au moment de convertir la plage en tableau, tu n'as peut-être pas sélectionner la ligne 1 aussi.
Autre chose, le macro du bouton FILTRER se nomme maintenant "FiltrerHarnais".
Remarque aussi que dans le fichier que je t'ai fait parvenir, j'ai aussi renommer la macro du bouton FILTRER dans la feuille ARA pour "FiltrerARA".... Voir module1.
ric
Super Ric,
Merci, tout est clair
Bravo et merci pour le temps que tu as bien voulu m'accorder, bonne continuation à toi.
Bien cordialement
Skatens
Bonjour skatens, ric,
J'ai aussi modifié les champs nommés Critères et Extraire pour la feuille Harnais.
Ces champs se mettent automatiquement en place avec les macros :
Sub FiltrerARA()
Sheets("BdDARA").Range("TabDataAra[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A3:K4"), CopyToRange:=Range("A7:K7"), Unique:=False
End Sub
Sub FiltrerHarnais()
Sheets("BdDHarnais").Range("TabDataHarnais[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A3:F4"), CopyToRange:=Range("A7:F7"), Unique:=False
End Sub
Bravo pour l'utilisation extensive du code que j'ai proposé dans un topic. Je n'imaginais pas que cela soit utilisé en même temps sur autant d'onglets ! Bon courage pour la customisation. Mais du coup je me demande si on ne peut pas quasiment tout regrouper en une seule macro plus générique en jouant sur les noms d'onglets. Je vais y réfléchir.
Je n'avais pas vu "passer" cette demande ... mais bravo ric pour ton intervention !
Pour filtrer ... utilise cette macro qui doit fonctionner dans tous les cas
Sub Filtrer()
Sheets("BdD" & ActiveSheet.Name).ListObjects(1).Range.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A3").CurrentRegion, _
CopyToRange:=Range("A7").CurrentRegion, Unique:=False
End Sub
Les conditions sont :
- la feuille BdDXXXX doit exister, XXXX étant le nom d ela feuille où se déroule le filtrage
- les conditions sont en A3..............
- les données filtrées sont en A7...............
Je vais faire de même pour les menus déroulants.
Bonjour à tous,
Effectivement, cette dernière macro, bonne pour tous les cas, fonctionne très bien.
ric
J'ai également rendu la macro des listes plus "universelle"
ps : c'est pal mal cette demande, cela m'a poussé dans mes retranchements !
Dans ThisWorkBook (pour ne pas avoir à la dupliquer)
' CONDITIONS
' la cellule A1 de la feuille commence par le texte "AIDE A LA PRECO"
' la feuille "BdDXXXXX" doit exister et comporter un tableau, XXXX étant la feuille où sont construites les listes déroulantes dépendantes
' les listes déroulantes concernent les cellules A4 et suivantes
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim nbZones As Integer
Dim data() As Variant
Dim choix() As Variant
Dim dico As Object
Dim i&, iData&, iZone&
If Not Sh.Range("A1").Value Like "AIDE A LA PRECO*" Then Exit Sub
nbZones = Cells(3, Columns.Count).End(xlToLeft).Column
If Target.Count <> 1 Then Exit Sub
ReDim choix(1 To nbZones)
For i = 1 To nbZones
choix(i) = Cells(4, i).Value
If Not Intersect(Cells(4, i), Target) Is Nothing Then
data = Sheets("BdD" & Sh.Name).ListObjects(1).DataBodyRange.Value
Set dico = CreateObject("Scripting.Dictionary")
For iData = 1 To UBound(data)
flag = True
If i > 1 Then
For iZone = 1 To i - 1
If choix(iZone) <> CStr(data(iData, iZone)) Then flag = False
Next
End If
If flag Then dico(CStr(data(iData, i))) = ""
Next iData
If dico.Count > 0 Then
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Join(dico.keys, ",")
End If
Exit For
End If
Next i
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim nbZones As Integer
If Not Sh.Range("A1").Value Like "AIDE A LA PRECO*" Then Exit Sub
nbZones = Cells(3, Columns.Count).End(xlToLeft).Column
For i = 1 To nbZones
If Not Intersect(Cells(4, i), Target) Is Nothing Then
If i < nbZones Then
Application.EnableEvents = False
For iZone = i + 1 To nbZones
With Cells(4, iZone)
.Value = ""
.Validation.Delete
End With
Next
Application.EnableEvents = True
End If
Exit For
End If
Next
End Sub