Private Sub Worksheet_Activate()
[A1].Select 'lorsque tu actives cette feuille, tu sélectionnes la cellule A1
'ceci afin de recréér une liste de validation quand tu sélectionnes A2
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then 'si la cellule modifiée est A2
Sheets("Feuil1").Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A1:A2"), CopyToRange:=Range("B3:D3"), Unique:=False
'Filtre élaboré de ta base de données, le critère en A2, et l'extraction en B3:D3
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ListClients As Object 'déclaration des variables
Dim DerLig As Long
Dim Cel As Range
If Target.Address = "$A$2" Then 'si tu as sélectionné la cellule A2
Set ListClients = CreateObject("Scripting.Dictionary") 'création d'un objet Dictionnary
With Sheets("Feuil1") 'avec la feuille "Feuil1"
DerLig = .[A65000].End(xlUp).Row 'calcul de la dernière ligne remplie
.Range("A2:D" & DerLig).Name = "base" 'on nomme la zone de travail
'ici de A2 à D13
'si le tableau va jusqu'à la colonne F, remplace le D par F
For Each Cel In .Range("A3:A" & DerLig) 'pour toutes les cellules de la colonne A
ListClients.Item(Cel.Value) = Cel.Value 'on rajoute les valeurs dans l'objet, de façon unique
Next Cel
End With
For Each it In ListClients.items 'on liste tous les numéros de clients
tmp = tmp & "," & ListClients.Item(it) 'on les rentre dans un tableau
Next it
tmp = Right(tmp, Len(tmp) - 1) 'on supprime la première virgule
With Target.Validation 'on va créé la liste de validation
.Delete 'tout d'abord, on supprime l'ancienne
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=tmp
'puis on rajoute une nouvelle, avec les numéros de clients
End With
End If
End Sub
