Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With [Tableau1] 'tableau structuré
If Intersect(ActiveCell, .Rows(.Rows.Count + 1)) Is Nothing Then Exit Sub
End With
On Error Resume Next
If Not ActiveCell(0).Validation.InCellDropdown Then Exit Sub
On Error GoTo 0
ActiveCell.Validation.Delete 'RAZ
ActiveCell.Validation.Add xlValidateList, Formula1:=ActiveCell(0).Validation.Formula1
CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
End Sub