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