Sub Макрос1()
       Dim iLastRow As Long, rw As Long
       Dim i As Integer
    Range("B4:D22").ClearContents
   With Sheets("list1")
   iLastRow = .Cells(Rows.Count, 3).End(xlUp).Row
     rw = 4
   For i = 3 To iLastRow
  If .Cells(i, 2).Value = 1 Then
  Cells(rw, 2).Resize(, 3).Value = .Cells(i, 3).Resize(, 3).Value
  rw = rw + 1
  End If
         Next
   End With
  End Sub

=ФИЛЬТР(list1!C3:E18;list1!B3:B18)

=ЕСЛИОШИБКА(ИНДЕКС(list1!$C$1:$C$9999;ПОИСКПОЗ(1;ИНДЕКС(list1!$B$1:$B$9999;ПОИСКПОЗ(B3;list1!$C$1:$C$9999;)+1):list1!$B$9999;)+ПОИСКПОЗ(B3;list1!$C$1:$C$9999;));"")

Sub u_814()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    If a > 3 Then Range("a4:d" & a).Clear
    b = Sheets("list1").Cells(Rows.Count, "b").End(xlUp).Row
    c = Application.Sum(Sheets("list1").Range("b3:b" & b))  'кол-во 1
    If c > 0 Then
        d = 3 'строка, с которой ищем след. 1
        For e = 1 To c
            f = Application.Match(1, Sheets("list1").Range("b" & d & ":b" & b), 0)
            g = Cells(Rows.Count, "a").End(xlUp).Row + 1 'строка вставки
            d = d + f
            Sheets("list1").Range("b" & d - 1 & ":e" & d - 1).Copy Range("a" & g)
            Range("a" & g) = e
        Next
    End If
    Application.ScreenUpdating = True
End Sub