Необходимо скопировать диапазон "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
Благодарю!