XL 2013 Problème avec liste déroulante

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Or [D1] = "" Then Exit Sub
Dim a$
[D1].Select
With Tabelle5.[A:A] 'feuille "Baustellenliste"
  .Find("", , xlValues) = [D1] 'la 1ère cellule vide est remplie
  .Sort .Columns(1), xlAscending, Header:=xlYes 'tri alphabétique de la liste
  .RemoveDuplicates Columns:=1, Header:=xlNo 'supprime les doublons
  a = .Cells(2).Resize(Application.CountA(.Cells) - 1).Address(External:=True)
End With
With [D1:R1].Validation
  .Delete
  .Add xlValidateList, Formula1:="=" & a
  .ShowError = False 'désactive l'alerte
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Or [D1] = "" Then Exit Sub
[D1].Select
With Tabelle5.[A:A] 'feuille "Baustellenliste"i
  .Find("", , xlValues) = [D1] 'la 1ère cellule vide est remplie
  .Sort .Columns(1), xlAscending, Header:=xlYes 'tri alphabétique de la liste
  .RemoveDuplicates Columns:=1, Header:=xlNo 'supprime les doublons
End With
End Sub

=DECALER(Baustellenliste!$A$1;1;;EQUIV("zzz";Baustellenliste!$A:$A)-1)