Как скопировать согласно списка "блоки" и вставить

Sub Макрос1()
lr = Sheets("список").Cells(Rows.Count, 1).End(xlUp).Row
ReDim m(1 To lr)
For i = 2 To lr
    m(i) = CStr(Sheets("список").Cells(i, 1).Value)
Next
m(1) = "#1"
    Range("A1:H1").AutoFilter
    ActiveSheet.Range("$A$1:$H$55").AutoFilter Field:=1, Criteria1:=Array(m), Operator:=xlFilterValues
    Range("A1:H55").SpecialCells(xlCellTypeVisible).Copy
    Sheets("результат").Range("A15").PasteSpecial
    Application.CutCopyMode = False
    Range("A1:H1").AutoFilter
End Sub

Public Sub www()
    Dim a, b, c, d, i&, j&, n&, m&
    a = Sheets("Шаблон").[b5].CurrentRegion.Columns(1)
    d = a
    b = Sheets("данные с отчета").[b5].CurrentRegion
    ReDim Preserve a(1 To UBound(a), 1 To UBound(b, 2))
    ReDim c(1 To UBound(a), 1 To UBound(b, 2))
    On Error Resume Next
    For i = 1 To UBound(b)
        n = Application.Match(b(i, 1), d, 0)
        If Err Then
            Err.Clear: m = m + 1
            For j = 1 To UBound(b, 2)
                c(m, j) = b(i, j)
            Next
        Else
            For j = 2 To UBound(b, 2)
                a(n, j) = b(i, j)
            Next
        End If
    Next
    On Error GoTo 0
    Stop
    Sheets("нужный результат").[i5].Offset(UBound(a)) = "отсутствует"
    Sheets("нужный результат").[i5].Resize(UBound(a), UBound(a, 2)) = a
    If m Then Sheets("нужный результат").[i5].Offset(UBound(a) + 1).Resize(m, UBound(a, 2)) = c
End Sub