ReDim Preserve 2-dimensionaler Array

Sub TXTEinlesen()
Dim arr() As String
Dim arr2() As Variant
Dim File As String
Dim z As Long
Dim row As Long
Dim I As Long
File = "C:\Users\Anton\Desktop\109950.txt"
Open File For Input As #1
I = 0
row = 0
z = 0
ReDim arr2(row, z)
Do Until EOF(1)
ReDim Preserve arr(I)
Line Input #1, arr(I)
arr = Split(Application.WorksheetFunction.Trim(arr(I)), " ")
I = I + 1
For z = LBound(arr) To UBound(arr)
arr2 = ReDimPreserve(arr2(), row, z)
arr2(row, z) = arr(z)
Next z
row = row + 1
Loop
Close #1
End Sub

'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Long,  _
nNewLastUBound As Long) As Variant
Dim nFirst As Long
Dim nLast As Long
Dim nOldFirstUBound As Long
Dim nOldLastUBound As Long
ReDimPreserve = False
'check if its in array first
If IsArray(aArrayToPreserve) Then
'create new array
ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
'get old lBound/uBound
nOldFirstUBound = UBound(aArrayToPreserve, 1)
nOldLastUBound = UBound(aArrayToPreserve, 2)
'loop through first
For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound
'if its in range, then append to new array the same way
If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast)
End If
Next
Next
'return the array redimmed
If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
End If
End Function