Sub uuu()
    'объявляем переменные
    Dim a() 'динамический массив (пока что безразмерный)
    Dim i&, j&, rw& 'длинные целые числа (счётчики)
'-------------------
    'присваиваем переменной значения диапазона с листа
    'массив сам примет нужные размеры
    a = Sheets("Area1").UsedRange.Value
    With Sheets("Лист4") 'ссылка на объект для упрощения синтаксиса
        'в пределах конструкции With ... End With, если будет нужно ссылаться на "лист4" пишем точку
        For rw = 3 To .Cells(Rows.Count, 2).End(xlUp).Row 'цикл от 3 до номера последней непустой ячейки во 2-м столбце
            If .Cells(rw, 2) <> "" Then 'если значение ячейки не пусто то
                For i = 1 To UBound(a) 'цикл по массиву от 1 до наибольшего индекса 1-го измерения массива (строки)
                    'сравниваем значение из массива со значением во 2-м столбце, ищем животное
                    If a(i, 1) = .Cells(rw, 2) Then 'если значение элемента массива равно значению ячейки то
                        rw = rw + 1 'увеличиваем счётчик строк
                        For j = 1 To UBound(a, 2) 'цикл от 1 до наибольшего индекса 2-го измерения массива (столбцы)
                            'вносим значения в соответствующие ячейки из массива на лист
                            .Cells(rw, j + 1) = a(i, j) 'j + 1 потому что в массиве <=15 в 3-м столбце а на листе 4 в 4-м
                        Next
                    End If
                Next
            End If
        Next
    End With
    MsgBox "Фсё гуд!" 'сообщеньице
End Sub

Sub uuu()
'задаем переменные массиву и значениям: i,j
    Dim a()                 
    Dim i&, j&
'---------------
'задаем переменную a как массив (лист "Area1")   
  a = Sheets("Area1").UsedRange.Value   
  
  'Задаем массив (с 3 строки 2 столбца до конца)для "Листа4"              
    With Sheets("Лист4")
        For rw = 3 To .Cells(Rows.Count, 2).End(xlUp).Row    

'Если в заданном массиве ячейка не пуста, то      
If .Cells(rw, 2) <> "" Then     
       
'Находим совпадение этой непустой ячейки на "Листе4" (с ячейкой на листе "Area1")       
                For i = 1 To UBound(a)                   
                    If a(i, 1) = .Cells(rw, 2) Then

'Далее. Строку принимаем равной (последняя строка +1)                    
                      rw = rw + 1                  
'Вот тут я не совсем понимаю!!! Мы опять задаем массив для "Area1" для поиска 2-го значения?                      
                         For j = 1 To UBound(a, 2)       
'Почему мы в качестве столбца задаем данные по строке (j)?              
                            .Cells(rw, j + 1) = a(i, j)                     
                        Next
                    End If
                Next
            End If
        Next
    End With
    MsgBox "Фсё гуд!"

Sub uuu()
    Dim a()
    Dim b()
    Dim i&, j&, q&
'---------------
    a = Sheets("Area1").UsedRange.Value
    b = Sheets("Критерий").UsedRange.Value 'присвоил переменное значение диапазону Лист:"Критерий"
    
      With Sheets("Лист4")
        For rw = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
            If .Cells(rw, 2) <> "" Then
                For i = 1 To UBound(a)
                  For q = 1 To UBound(b) 'цикл по массиву от 1 до наибольшего индекса 1-го измерения массива
                
                    If a(i, 1) = b(q, 1) Then 'Если значение элекмента массива ("Area1") = значению элекмента массива ("Критерий"), то
                        rw = rw + 1
                         
                        For j = 1 To UBound(a, 2)
                            .Cells(rw, j + 1) = a(i, j)
                            .Cells(rw + 1, 2).FormulaR1C1 = "Итого:" 'Пытался добавить строку [итого], но он ее добавляет после того как сформирует массив по критериям
                             Next
                        End If
                    Next
                Next
            End If
        Next
        Dim lLastRow As Long
       End With
    MsgBox "Фсё гуд!"
End Sub

Sub Макрос1()
    ActiveSheet.UsedRange.Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Paste
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1"), _
                             SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange .UsedRange.Offset(1)
        .Sort.Header = xlGuess
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
        .UsedRange.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, _
                    7, 8, 9, 10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        .UsedRange.ClearOutline
    End With
End Sub

Sub uuu()
    Dim a(), b()
    Dim i&, ii&, rw&, x&, lr&
'-----------------------------
    'берём диапазоны в массивы
    a = Sheets("Area1").UsedRange.Value
    b = Sheets("Критерий").UsedRange.Value
    
    With Sheets("Лист4")
        rw = 3 'номер первой строки для выгрузки
        lr = .UsedRange.Rows.Count 'номер последней строки диапазона
        If lr > 3 Then 'если последняя строка больше первой  то
            .Rows(rw & ":" & lr).Delete 'удаляем строки с первой по последнюю
        End If
        For i = 2 To UBound(b) 'идём по массиву с критериями
            .Cells(rw, 2) = b(i, 1) 'вносим название группы
            .Cells(rw, 2).Font.Bold = True 'делаем жирным шрифт
            rw = rw + 1 'увеличиваем счётчик строк
            x = 1 'сбрасываем в начало счётчик позиций в группе
            For ii = 2 To UBound(a) 'проходим по массиву с данными
                'если значение не пусто и совпадает с названием группы то
                If a(ii, 1) <> "" And a(ii, 1) = b(i, 1) Then
                    .Cells(rw, 1) = x 'пишем номер позиции
                    For j = 1 To UBound(a, 2) 'вносим строку из массива на лист
                        .Cells(rw, j + 1) = a(ii, j)
                    Next
                    rw = rw + 1 'увеличиваем счётчик строк
                    x = x + 1 'увеличиваем счётчик позиций
                End If
            Next
            .Cells(rw, 2) = "Итого " & LCase(b(i, 1)) & ":" 'вносим итого
            .Cells(rw, 2).Font.Bold = True 'делаем шрифт жирным
            rw = rw + 1 'увеличиваем счётчик строк
        Next
    End With
    MsgBox "Готово!" 'радостная весть
End Sub