Запись данных из одного массива в другой, ошибка "Subscript out of range" - VBA

Sub slovosoch()
n = 1
Worksheets(1).Activate
Dim Arr()
Dim Str
Str = Split(Cells(2, 4))

    For k = LBound(Str) To UBound(Str)
        per = (2 ^ (k + 1)) / 2
        For j = LBound(Str) To 2 ^ (UBound(Str) + 1) - 1

            If n <= per Then
            Arr(j, k) = Str(k)
            n = n + 1
            ElseIf n > per Then
            For v = j To j + per - 1
            Arr(v, k) = "___"
            Next v
            j = j + per - 1
            n = n - per
            End If
            
'            If n <= per Then
'            Cells(j + 1, k + 6) = Str(k)
'            n = n + 1
'            ElseIf n > per Then
'            For v = j To j + per - 1
'            Cells(v + 1, k + 6) = "___"
'            Next v
'            j = j + per - 1
'            n = n - per
'            End If
    
        Next j
    Next k
 
End Sub

Arr(j, k) = Str(k)