Передать определенные строки Excel в массив

Dim Data()
Sheets(5).Activate
Data = Sheets(5).Range(Cells(2, 1), Cells(iLastrow, 6)).Value
Userform1.ListBox1.List = Data

Sheets(5).Activate
iLastrow = Sheets(5).Cells(Rows.Count, 1).End(xlUp).Row
 
'Заполнение Lisbox1 через массив перебором
    Dim Data()
    ReDim Preserve Data(1 To iLastrow, 1 To 6)
 
For i = 1 To iLastrow
 If Sheets("Список смет").Cells(i, 1) = "" Then GoTo Выход
     If Sheets("Список смет").Cells(i, 7) = 0 Then
        For j = 1 To 6
         Data(i, j) = Sheets("Список смет").Cells(i, j).Value
        Next j
        
    Else
    End If
 
Next i

 For i = 2 To iLastrow
        If Sheets(5).Cells(i, 7) = 1 Then
        ListBox1.AddItem Sheets(5).Cells(i, 1).Value
        ListBox1.List(ListBox1.ListCount - 1, 1) = Sheets(5).Cells(i, 2).Value
        ListBox1.List(ListBox1.ListCount - 1, 2) = Sheets(5).Cells(i, 3).Value
        ListBox1.List(ListBox1.ListCount - 1, 3) = Sheets(5).Cells(i, 4).Value
        ListBox1.List(ListBox1.ListCount - 1, 4) = Sheets(5).Cells(i, 5).Value
        ListBox1.List(ListBox1.ListCount - 1, 5) = Sheets(5).Cells(i, 6).Value
        Else
        End If
 Next i

Public Sub fnMas()
Dim d: Dim f()
d = [Таблица1]: j = 1
For i = 1 To UBound(d)
    If d(i, 7) = 1 Then
    ReDim f(1 To j)
    f(j) = d(i, 1) & vbTab & d(i, 2) & vbTab & d(i, 3) & vbTab & _
    d(i, 4) & vbTab & d(i, 5) & vbTab & d(i, 6)
    Debug.Print f(j) ' тут переменная f(j) которая набита отобранными данными _
    можете дальше использовать ее по своему усмотрению
    j = j + 1
    End If
Next
End Sub

Private Sub UserForm_Activate()
Dim d: Dim f()
d = [Таблица1]: j = 1
For i = 1 To UBound(d)
    If d(i, 7) = 1 Then
    ReDim Preserve f(1 To j)
    f(j) = d(i, 1) & vbTab & d(i, 2) & vbTab & d(i, 3) & vbTab & _
    d(i, 4) & vbTab & d(i, 5) & vbTab & d(i, 6)
    j = j + 1
    End If
Next
ListBox1.List = f
End Sub

Private Sub UserForm_Activate()
Dim d: Dim f()
d = [Таблица1]: j = 0
For i = 1 To UBound(d)
    If d(i, 7) = 1 Then
        j = j + 1
    End If
Next
ReDim Preserve f(j, 7): j = 0
For i = 1 To UBound(d)
    If d(i, 7) = 1 Then
        For r = 1 To 7
            f(j, r) = d(i, r)
        Next
        j = j + 1
    End If
Next
With ListBox1
    .ColumnCount = 7
    .Clear
    .List = f
 End With
End Sub