Laufzeitfehler, Index außerhalb des Gültigen Berei

Sub arrayAnlegen()
dim BlattListe1, BlattListe2 as Variant
dim ZeilenAnz as Integer
'BlattListe1
'In dieser Schleife funktionniert es wunderbar
ZeilenAnz = Tabelle1.Range("Zellbereich1").Count
ReDim BlattListe1(1 To ZeilenAnz)
For I = 1 To ZeilenAnz
BlattListe1(I) = Tabelle1.Range("Zellberich1")(I)
Next I
'BlattListe2
'In dieser Schleife habe ich ein Problem
ZeilenAnz = Tabelle1.Range("Zellberich3").Count
ReDim BlattListe2(1 To ZeilenAnz, 1 To ZeilenAnz, 1 To ZeilenAnz)
For I = 1 To ZeilenAnz
BlattListe2(1, I) = Tabelle1.Range("Zellbereich3")(I) 'Laufzeitfehler
BlattListe2(2, I) = Tabelle1.Range("Zellbereich4")(I)
BlattListe2(3, I) = Tabelle1.Range("Zellbereich5")(I)
Next I
End Sub