Validation en cascade sur listes avec trous

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Intersect([A2:A10], Target) Is Nothing Then
   Set d = CreateObject("scripting.dictionary")
   For Each c In Application.Index([bd], , 1)
     If c <> "" Then
       temp = c.Value & c.Offset(, 6).Value
       d(temp) = ""
     End If
   Next c
   Sheets("bd").[J2].Resize(d.Count) = Application.Transpose(d.keys)
 End If
 '--
 If Not Intersect([b2:e10], Target) Is Nothing And Target.Count = 1 Then
  col = Target.Column
  Sheets("bd").Cells(2, 9 + col).Resize(100).ClearContents
  If Target.Offset(, -1) <> "" Then
    Set d = CreateObject("scripting.dictionary")
    For Each c In Application.Index([bd], , col)
     If c.Value <> "" Then
       If Left(c, col - 1) = Left(Target.Offset(, -1), col - 1) Then
         temp = c.Value & c.Offset(, 7 - col).Value
         d(temp) = ""
       End If
      End If
    Next c
    If d.Count > 0 Then Sheets("bd").Cells(2, 9 + col).Resize(d.Count) = Application.Transpose(d.keys)
   End If
  End If
End Sub