Excel VBA Макросы: Копирование строк с нескольких листов на один.

[Роман]

Необходимо скопировать диапазон "B2:AM2" из листа "1" в лист "Итого", вставить после итоговой строки, залитой желтым, в те же столбцы, что и на листе "1".

В дальнейшем, в книгу будут добавлены листы с названиями по возрастающей: 2,3,4,5... и так далее.
Диапазоны "B2:AM2" из них так же вставляются в лист "Итого", сверху вниз, согласно названиям листов, от "1" и вниз по возрастающей.

Названия листов соответствуют значениям в ячейке "B2" для каждого листа. Желательна замена скопированного диапазона любого из листов в листе "Итого" (скажем, если поменялась информация в диапазоне листа "7", то удалить его из листа "Итого", и вставить заново, между диапазонами "6" и "8" листов).

За основу были взяты макросы из этого сообщения. Попытался их переписать под себя, не получилось, при проигрывании кода выскочила ошибка (во вложении). Попытки разобраться закончились неудачей. У меня нет опыта написания макросов. Прошу помочь.

[вложение удалено администратором]

[Администратор]

Макрос

Sub Main_Copy()

    Dim shSrc As Worksheet, shRes As Worksheet, DoSort As Boolean
    Dim r As Long
   
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Присваиваем имя "shSrc" активному листу.
    Set shSrc = ActiveSheet
   
    '3. Присваиваем имя "shRes" листу-результату.
        ' Здесь укажите имя файла-результата и имя или порядковый номер листа-результата.
    Set shRes = Worksheets("Итого")
   
    '4. Поиск на листе-результате номера.
    On Error Resume Next
    r = WorksheetFunction.Match(shSrc.Range("B2").Value, shRes.Columns("B"), 0)
    On Error GoTo 0
   
    '5. Если номер не найден, то поиск последней строки.
        ' End не ищет в скрытых строках.
    If r = 0 Then
        r = shRes.Cells(shRes.Rows.Count, "B").End(xlUp).Row + 1
        ' Если столбец B пустой, то данные нужно начать вставлять со строки 8.
        If r < 8 Then
            r = 8
        ' Иначе данные будут вставлены под имеющимися данными и чтобы установить
            ' лист в нужную строку нужно сделать сортировку.
            ' Делаем пометку, что нужно сделать сортировку.
        Else
            DoSort = True
        End If
    End If
   
    '6. Копирование диапазона. Вставляются только значения (без формул и оформления).
    shSrc.Range("B2:AM2").Copy
    shRes.Cells(r, "B").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
   
    '7. Сортировка, если это надо.
    If DoSort = True Then
        With shRes.Sort
            .SortFields.Clear
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlSortColumns
            .SortFields.Add Key:=shRes.Columns("B")
            .SetRange shRes.Range("B8:AM" & r)
            .Apply
        End With
    End If
   
    '8. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '9. Сообщение, чтобы юзер понял, что макрос сделал работу.
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Роман]

Благодарю!