Перенос и компоновка данных с листа на лист через массив

Sub prib1()
Dim iLastRow As Long, jLastRow As Long, i As Long, j As Long
iLastRow = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
For i = iLastRow To 2 Step -1
If Cells(i, 2) = 1 Then
Sheets("Лист2").Select
jLastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
Cells(jLastRow + 1, 1) = Sheets("Лист1").Cells(i, 3)
Cells(jLastRow + 1, 2) = Sheets("Лист1").Cells(i, 4)
End If
Sheets("Лист1").Select
Next
End Sub
 
Sub macr()
Dim LastRow As Variant, jLastRow As Long
Dim i As Long
Dim myArray()
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
myArray = Range("A2" & LastRow)
For i = LBound(myArray) To 1 Step -1
If myArray(i, 2) = 1 Then
Sheets("Лист2").Select
jLastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
Cells(jLastRow + 1, 1) = myArray(i, 3)
Cells(jLastRow + 1, 2) = myArray(i, 4)
Exit For
End If
Next
End Sub

Sub tt()
    Dim a(), i&, d1 As Object, d2 As Object
    Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
    Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1
 
    a = Sheets("Лист1").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        If a(i, 2) = 1 Then
            d1.Item(a(i, 3)) = d1.Item(a(i, 3)) + a(i, 4)
        Else
            d2.Item(a(i, 3)) = d2.Item(a(i, 3)) + a(i, 4)
        End If
    Next
 
    With Sheets("Лист2")
        .Cells.Clear
        .Cells(1, 1) = "Прибытие"
        .Cells(2, 1) = "Товар"
        .Cells(2, 2) = "Количество"
        .Cells(3, 1).Resize(d1.Count, 2) = Application.Transpose(Array(d1.keys, d1.items))
 
        .Cells(d1.Count + 4, 1) = "Убытие"
        .Cells(d1.Count + 5, 1) = "Товар"
        .Cells(d1.Count + 5, 2) = "Количество"
        .Cells(d1.Count + 6, 1).Resize(d2.Count, 2) = Application.Transpose(Array(d2.keys, d2.items))
    End With
End Sub

Sub tt()
    Dim a(), i&, d1 As Object, d2 As Object
    Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
    Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1
 
    a = Sheets("Лист1").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        If a(i, 2) = 1 Then
            d1.Item(a(i, 3)) = d1.Item(a(i, 3)) + a(i, 4)
        Else
            d2.Item(a(i, 3)) = d2.Item(a(i, 3)) + a(i, 4)
        End If
    Next
 
    With Sheets("Лист2")
        .Cells.Clear
        .Cells(1, 1) = "Прибытие"
        .Cells(2, 1) = "Товар"
        .Cells(2, 2) = "Количество"
        .Cells(3, 1).Resize(d1.Count, 2) = Application.Transpose(Array(d1.keys, d1.items))
        .Range(.Cells(1, 1), Cells(2 + d1.Count, 2)).Borders.Weight = xlThin
 
        .Cells(d1.Count + 4, 1) = "Убытие"
        .Cells(d1.Count + 5, 1) = "Товар"
        .Cells(d1.Count + 5, 2) = "Количество"
        .Cells(d1.Count + 6, 1).Resize(d2.Count, 2) = Application.Transpose(Array(d2.keys, d2.items))
        .Range(.Cells(d1.Count + 4, 1), Cells(5 + d1.Count + d2.Count, 2)).Borders.Weight = xlThin
    End With
End Sub