Bonjour,
il faut faire un click droit dessus et faire affecter une macro ensuite tu entrera dans une fentre avec (rectangle click) tu fais nouvelle macro et tu va entrer sous la vba ou il te faudra ecrire du code
fais deja ceci et on continuera a t'aider pour le copier coller etc...
A+
Bonjour
Je confirme : la demande n'est pas claire .
peux tu préciser par exemple en indiquant ton résultat souhaité dans ta feulle2.
Car pour l'instant j'ai beau chercher ce que tu veux faire je ne comprends pas
Dim Cel As Range
Dim LesEm As Object
Private Sub Worksheet_Activate()
Range("A1").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address = "$A$3" Then
Range("A7:F1000").Clear
Range("C3").FormulaR1C1 = _
"=AND(Feuil1!R[2]C19=R3C1,Feuil1!R[2]C22<>"""",Feuil1!R[2]C23="""")"
Sheets("Feuil1").Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"C2:C3"), CopyToRange:=Range("A6:F6"), Unique:=False
[C3].Clear
Cells.EntireColumn.AutoFit
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address = "$A$3" Then
Set LesEm = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
.Range("A4:X" & .[A65000].End(xlUp).Row).Name = "base"
For Each Cel In .Range("S5:S" & .[S65000].End(xlUp).Row)
If Cel <> "" Then LesEm(Cel.Value) = Cel.Value
Next Cel
End With
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(LesEm.Items, ",")
End With
End If
End Sub
Bonjour,
Regarde le fichier joint, pas besoin de bouton, tu modifies la valeur de la cellule A3, qui contient maintenant une liste de validation, et tu obtiens tes données par le biais d'un filtre élaboré..
Le code (dans l'évènement de la feuille 2) :
Code:Dim Cel As Range Dim LesEm As Object Private Sub Worksheet_Activate() Range("A1").Select End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Address = "$A$3" Then Range("A7:F1000").Clear Range("C3").FormulaR1C1 = _ "=AND(Feuil1!R[2]C19=R3C1,Feuil1!R[2]C22<>"""",Feuil1!R[2]C23="""")" Sheets("Feuil1").Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "C2:C3"), CopyToRange:=Range("A6:F6"), Unique:=False [C3].Clear Cells.EntireColumn.AutoFit End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Address = "$A$3" Then Set LesEm = CreateObject("Scripting.Dictionary") With Sheets("Feuil1") .Range("A4:X" & .[A65000].End(xlUp).Row).Name = "base" For Each Cel In .Range("S5:S" & .[S65000].End(xlUp).Row) If Cel <> "" Then LesEm(Cel.Value) = Cel.Value Next Cel End With With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Join(LesEm.Items, ",") End With End If End Sub
Bonne journée
Edit, un peu à la bourre....Salut Ges et JM