Option Explicit

Sub otbor()
    Dim arr(), i&, ai&, bi&, ci&, b(), c(), poz&
    Dim sa As Double, sb As Double

    'отключаем обновление экрана - сэкономим миллисекунду, но не будет мигать
    Application.ScreenUpdating = False

    'данные в массив
    With Sheets( 2 )
        arr = .Range(.Range("A" & .Rows.Count).End(xlUp), .[G1]).Value
    End With

    'создаём пустые массивы, сразу с заголовком
    ReDim a( 1  To UBound(arr),  1  To  4 )
    a( 1 ,  1 ) = "ТЕКСТ": a( 1 ,  4 ) = "ЧИСЛО"
    b = a
    ReDim c( 1  To UBound(arr),  1  To  2 )
    c( 1 ,  1 ) = "ТЕКСТ": c( 1 ,  2 ) = "НОМЕР"

    'заголовок уже посчитаем
    ai =  1 
    bi =  1 
    ci =  1 

    'перебор массива
    For i =  1  To UBound(a)
        'отбор данных
        Select Case arr(i,  1 )
        Case  2 
            ai = ai +  1 
            a(ai,  1 ) = arr(i,  4 )
            a(ai,  4 ) = arr(i,  7 )
            sa = sa + CDbl(arr(i,  7 ))
        Case  3 
            bi = bi +  1 
            b(bi,  1 ) = arr(i,  4 )
            b(bi,  4 ) = arr(i,  7 )
            sb = sb + CDbl(arr(i,  7 ))
        Case  1 
            ci = ci +  1 
            c(ci,  1 ) = arr(i,  4 )
            c(ci,  2 ) = arr(i,  3 )
        End Select
    Next

    'выгрузка и сразу рамки
    poz =  1 
    With Sheets( 1 )
        With .Cells(poz,  1 )
            .Resize(ai,  4 ).Value = a
            .Resize(ai,  4 ).Borders.Weight = xlThin
            .Resize( 1 ,  4 ).Borders.Weight = xlMedium
        End With
        poz = poz + ai
        .Cells(poz,  1 ) = "Итого:"
        .Cells(poz,  4 ) = sa
        poz = poz +  3 

        With .Cells(poz,  1 )
            .Resize(bi,  4 ).Value = b
            .Resize(bi,  4 ).Borders.Weight = xlThin
            .Resize( 1 ,  4 ).Borders.Weight = xlMedium
        End With
        poz = poz + bi
        .Cells(poz,  1 ) = "Итого:"
        .Cells(poz,  4 ) = sb
        poz = poz +  4 

        With .Cells(poz,  1 )
            .Resize(ci,  2 ).Value = c
            .Resize(ci,  2 ).Borders.Weight = xlThin
            .Resize( 1 ,  2 ).Borders.Weight = xlMedium
        End With
    End With

    'включаем обновление экрана
    Application.ScreenUpdating = True
End Sub

     'выгрузка
    With Sheets( 1 )
        With .Cells( 2 ,  1 ) 'тут промахнулся в приложении, там (1, 1) написано....
            .Resize(ai,  4 ).Value = a
        End With

        With .Cells( 23 ,  1 )
            .Resize(bi,  4 ).Value = b
        End With

        With .Cells( 45 ,  1 )
            .Resize(ci,  2 ).Value = c
        End With
    End With

    'выгрузка
    With Sheets( 1 )
        .Cells( 2 ,  1 ).Resize(ai,  4 ).Value = a
        .Cells( 23 ,  1 ).Resize(bi,  4 ).Value = b
        .Cells( 45 ,  1 ).Resize(ci,  2 ).Value = c
    End With

    'выгрузка
    With Sheets( 1 )
        .Cells( 2 ,  1 ).Resize(ai,  4 ).Value = a
        .Cells( 23 ,  1 ).Resize(bi,  4 ).Value = b
       If ci >  0  Then .Cells( 45 ,  1 ).Resize(ci,  2 ).Value = c
    End With

     'выгрузка
    With Sheets( 1 )
        .Cells( 2 ,  1 ).Resize(ai,  4 ).Value = a
        .Cells( 23 ,  1 ).Resize(bi,  4 ).Value = b
       If ci >  0  Then
       .Cells( 45 ,  1 ).Resize(ci,  2 ).Value = c
       Else
       Rows("43:62").Delete
       End If
    End With

    'выгрузка
    With Sheets( 1 )
        .Cells( 2 ,  1 ).Resize(ai,  4 ).Value = a
        .Cells( 23 ,  1 ).Resize(bi,  4 ).Value = b
       If ci >  0  Then .Cells( 45 ,  1 ).Resize(ci,  2 ).Value = c Else Rows("43:62").Delete
    End With

 
       If ci >  0  Then .Cells( 45 ,  1 ).Resize(ci,  2 ).Value = c Else .Rows("43:62").Delete