Problem mit VBA Gültigkeit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim iRow As Integer
Dim sVal As String
If Target.Column  2 Then Exit Sub
With Sheets(Tabelle1.Name)
For iRow = 2 To .Range("A20").CurrentRegion.Rows.Count
If .Rows(iRow).Hidden = False Then
If sVal = "" Then
sVal = .Range("A1").CurrentRegion.Cells(iRow, 2).Value
Else
sVal = sVal & "," & .Range("A1") _
.CurrentRegion.Cells(iRow, 2).Value
End If
End If
Next iRow
With Target.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=sVal
.IgnoreBlank = True
.InCellDropdown = True
End With
.AutoFilterMode = False
End With
End Sub

nun zu meinen Problemen:
1. in der Gültigkeit sollen alle Texte (ausser leere Zellen) stehen, tut es aber nicht
2. ist ein text zu lange wird er nich vollständig in die zelle eingetragen
was nach ich falsch?
Bescheibung meiner Arbeitsmappe:
im Tabellenblatt (Typ_1) in der Spalte H1 bis H200 stehen meine Texte. (Gültigkeitsliste)
im Tabellenblatt (TT_E_87) in der Spalte B8 bis B48 sollte die Gültigkeits eingetragen werden mit den SelectionChange ereigniss
Habe meine Arbeitsmappe mit hochgeladen, bitte helft mir weiter
https://www.herber.de/bbs/user/55926.xls
Gruß
Erich