Afficher liste validation sous condition...

Sub Test()
    On Error Resume Next
    Columns(8).SpecialCells(xlCellTypeAllValidation).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:="=if($E2>42000,Liste,"""")"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Range("H2").Select
End Sub

Private Sub CommandButton1_Click()
    Const MCM_FIRST& = &H1000&, MCM_GETCURSEL& = (MCM_FIRST + 1&)
    Dim LeTime As SYSTEMTIME
    'Récuperer la date sélectionnée dans une cellule
    SendMessage mWnd, MCM_GETCURSEL, 0&, LeTime
    With LeTime
        'MsgBox "Vous avez choisi le : " & vbNewLine & vbTab & _
         Format(DateSerial(.wYear, .wMonth, .wDay), "dddd dd mmmm yyyy") & "."
        Date2 = DateSerial(.wYear, .wMonth, .wDay)
        'Récupérer la date sélectionnée dans une TextBox
        If Not ObjetSource Is Nothing Then
            If InStr(1, "Range,TextBox", TypeName(ObjetSource)) > 1 Then ObjetSource.Value = Date2
        End If
    End With
    Unload Me
    On Error Resume Next
    Range("H2:H500").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:="=IF($E2>42000,Liste,"""")"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Range("H2").Select
End Sub

Private Sub CommandButton1_Click()Dim Cellule As Range
    Const MCM_FIRST& = &H1000&, MCM_GETCURSEL& = (MCM_FIRST + 1&)
    Dim LeTime As SYSTEMTIME
    SendMessage mWnd, MCM_GETCURSEL, 0&, LeTime
    With LeTime
        Date2 = DateSerial(.wYear, .wMonth, .wDay)
    End With
    Unload Me
    Set Cellule = ActiveCell
    On Error Resume Next
    Range("H2:H500").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:="=IF($E2>42000,Liste,"""")"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Cellule.Offset(, 3).Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[H:H].Validation.Delete 'RAZ
If Not Intersect(ActiveCell, [H:H]) Is Nothing Then
  If IsDate(ActiveCell(, -2)) Then
    Me.Unprotect "toto"
    ActiveCell.Validation.Add xlValidateList, Formula1:="=Liste"
    Me.Protect "toto"
  End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sel As Range, ac As Range
Range("H3:H" & Rows.Count).Validation.Delete 'RAZ
Set sel = Selection: Set ac = ActiveCell
If Not Intersect(ac, [H:H]) Is Nothing Then
  If IsDate(ac(, -2)) Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    [H2].Select: [H2] = ac: [H2].Copy ac
    sel.Select: ac.Activate
    Application.EnableEvents = True
  End If
End If
End Sub