Liste en cascade et sans blanc à partir d'un fichier qui contient des cellules vides

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([A2:A100], Target) Is Nothing Then
      Set d1 = CreateObject("Scripting.Dictionary")
      For Each c In [niveau1]:  d1(c.Value) = "": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d1.keys, ",")
     End If
     '-- niv 2
     If Not Intersect([B2:B100], Target) Is Nothing Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [niveau2]
         tmp = c.Offset(0, -1): If tmp = "" Then tmp = c.Offset(0, -1).End(xlUp)
         If tmp = Target.Offset(, -1) Then d1(c.Value) = ""
       Next c
       Target.Validation.Delete
       If d1.Count > 0 Then Target.Validation.Add xlValidateList, Formula1:=Join(d1.keys, ",")
     End If
     '---niv3
     If Not Intersect([C2:C100], Target) Is Nothing Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [niveau3]
        If c <> "" Then
         tmp = c.Offset(0, -2): If tmp = "" Then tmp = c.Offset(0, -2).End(xlUp)
         tmp2 = c.Offset(0, -1):  If tmp2 = "" Then tmp2 = c.Offset(0, -1).End(xlUp)
         If tmp = Target.Offset(, -2) And tmp2 = Target.Offset(, -1) Then d1(c.Value) = ""
        End If
       Next c
       Target.Validation.Delete
       If d1.Count > 0 Then
         Target.Validation.Add xlValidateList, Formula1:=Join(d1.keys, ",")
       Else
         Target = ""
       End If
    End If
    '--- niv 4
     If Not Intersect([d2:d100], Target) Is Nothing Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [niveau4]
        If c <> "" Then
         tmp = c.Offset(0, -3): If tmp = "" Then tmp = c.Offset(0, -3).End(xlUp)
         tmp2 = c.Offset(0, -2): If tmp2 = "" Then tmp2 = c.Offset(0, -2).End(xlUp)
         tmp3 = c.Offset(0, -1):  If tmp3 = "" Then tmp3 = c.Offset(0, -1).End(xlUp)
         If tmp = Target.Offset(, -3) And tmp2 = Target.Offset(, -2) And tmp3 = Target.Offset(, -1) Then d1(c.Value) = ""
        End If
       Next c
       Target.Validation.Delete
       If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & Replace(c, ",", ".") & ",": Next c
         Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
        Else
          Target = ""
        End If
    End If
End Sub