Сборка отчёта из нескольких листов

Сквозная задача: макрос обходит все листы книги, стаскивает строки в один сводный лист и сам проставляет итоги.

Сводный лист — обычный лист книги, куда макрос переносит строки со всех остальных листов и дописывает колонку «откуда взято». Дальше с ним работают как с одной большой таблицей: фильтруют, строят сводную, считают итоги.

Задача, ради которой всё затевалось

Каждое утро на почту падает файл Продажи.xlsx. Внутри восемь листов — по одному на филиал: «Москва», «Санкт-Петербург», «Казань» и так далее. Шапка везде одинаковая, а строк на каждом листе от десяти до пятисот. Чтобы посчитать выручку компании целиком, человек открывает лист, выделяет данные, копирует, переключается на свой рабочий лист, ищет первую пустую строку, вставляет. Восемь раз. Двадцать минут в день, полтора часа в неделю — и один неверный Ctrl+V способен затереть чужие данные так, что никто этого не заметит до конца квартала.

Лист-источник выглядит примерно так (шапка в первой строке, данные — со второй):

      A             B          C            D            E
1   Дата        Менеджер     Товар     Количество     Сумма
2   05.03.2026  Иванов       Ноутбук        2         180000
3   05.03.2026  Петрова      Мышь          14          21000
4   06.03.2026  Иванов       Клавиатура     5          17500

Нам нужен лист «Свод»: те же пять колонок плюс шестая — «Источник» (имя листа, откуда приехала строка), а внизу строка «ИТОГО» с суммами по количеству и деньгам. Причём макрос должен пережить появление девятого филиала без единой правки кода.

Полный код макроса

Открой редактор (Alt+F11), вставь обычный модуль (меню Insert → Module) и положи туда весь код целиком — процедуру и вспомогательную функцию под ней.

Option Explicit

Sub BuildSummary()

    Dim wsTarget As Worksheet    ' лист-приёмник «Свод»
    Dim ws As Worksheet          ' текущий лист в цикле
    Dim lastSrcRow As Long       ' последняя строка листа-источника
    Dim lastDstRow As Long       ' последняя занятая строка свода
    Dim rowsToCopy As Long       ' сколько строк данных на источнике
    Dim totalRow As Long         ' строка с итогами

    Application.ScreenUpdating = False

    ' --- Шаг 1. Готовим лист-приёмник ---
    Set wsTarget = GetOrCreateSheet("Свод")
    wsTarget.Cells.Clear
    wsTarget.Range("A1:F1").Value = _
        Array("Дата", "Менеджер", "Товар", "Количество", "Сумма", "Источник")

    ' --- Шаг 2. Обходим все листы книги, кроме самого свода ---
    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> wsTarget.Name Then

            lastSrcRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            rowsToCopy = lastSrcRow - 1          ' минус строка шапки

            If rowsToCopy > 0 Then

                lastDstRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row

                ' переносим значения: 5 колонок за одно присваивание
                wsTarget.Cells(lastDstRow + 1, "A").Resize(rowsToCopy, 5).Value = _
                    ws.Range("A2:E" & lastSrcRow).Value

                ' в колонку «Источник» разом пишем имя листа
                wsTarget.Cells(lastDstRow + 1, "F").Resize(rowsToCopy, 1).Value = ws.Name

            End If

        End If

    Next ws

    ' --- Шаг 3. Итоги ---
    lastDstRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row

    If lastDstRow = 1 Then
        Application.ScreenUpdating = True
        MsgBox "Данных не нашлось. Проверь, что на листах заполнена колонка A.", vbExclamation
        Exit Sub
    End If

    totalRow = lastDstRow + 2
    wsTarget.Cells(totalRow, "A").Value = "ИТОГО"
    wsTarget.Cells(totalRow, "D").Formula = "=SUM(D2:D" & lastDstRow & ")"
    wsTarget.Cells(totalRow, "E").Formula = "=SUM(E2:E" & lastDstRow & ")"

    ' --- Шаг 4. Косметика ---
    wsTarget.Range("A1:F1").Font.Bold = True
    wsTarget.Range("A" & totalRow & ":F" & totalRow).Font.Bold = True
    wsTarget.Range("A2:A" & lastDstRow).NumberFormat = "dd.mm.yyyy"
    wsTarget.Range("E2:E" & totalRow).NumberFormat = "#,##0"
    wsTarget.Columns("A:F").AutoFit

    Application.ScreenUpdating = True
    wsTarget.Activate

    MsgBox "Готово. Перенесено строк: " & (lastDstRow - 1), vbInformation

End Sub


Private Function GetOrCreateSheet(ByVal sheetName As String) As Worksheet

    Dim ws As Worksheet

    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0

    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add( _
            After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        ws.Name = sheetName
    End If

    Set GetOrCreateSheet = ws

End Function

Результат:

      A             B          C            D           E         F
1   Дата        Менеджер     Товар     Количество    Сумма    Источник
2   05.03.2026  Иванов       Ноутбук        2       180 000   Москва
3   05.03.2026  Петрова      Мышь          14        21 000   Москва
4   06.03.2026  Сидоров      Монитор        3        75 000   Казань
...
40  12.03.2026  Кузнецов     Ноутбук        1        90 000   Уфа

42  ИТОГО                                214     4 815 000

Разбор по шагам

Option Explicit — строчка, которая экономит вечера

Option Explicit в самом верху модуля запрещает использовать переменные, которые ты не объявил. Без неё опечатка lastSrcRov вместо lastSrcRow не вызовет ошибку — VBA молча заведёт новую пустую переменную, макрос отработает и соберёт ноль строк. Ты будешь искать причину полчаса. С Option Explicit редактор ругнётся сразу, ещё до запуска.

Шаг 1. Лист-приёмник: найти или создать

Функция GetOrCreateSheet решает вечную дилемму «а вдруг листа «Свод» ещё нет». Приём такой: пробуем взять лист по имени, предварительно сказав On Error Resume Next — «если споткнёшься, не падай, иди дальше». Если листа нет, переменная ws останется пустой (Nothing), и мы создадим лист сами. Строчка On Error GoTo 0 обязательна: она возвращает обычную реакцию на ошибки. Забудешь её — макрос до конца работы будет глотать все ошибки, включая настоящие.

Дальше wsTarget.Cells.Clear вычищает лист целиком (значения, формулы, форматы). Это важно: если вчера строк было 500, а сегодня 300, без очистки внизу останется вчерашний хвост, и итоги посчитаются по мусору.

Шаг 2. Обход листов и поиск последней строки

For Each ws In ThisWorkbook.Worksheets перебирает все листы книги — сколько бы их ни было. Именно поэтому девятый филиал не потребует правок: он попадёт в цикл автоматически. Условие If ws.Name <> wsTarget.Name отсекает сам «Свод», иначе он начал бы копировать сам в себя.

Конструкция ws.Cells(ws.Rows.Count, "A").End(xlUp).Row — рабочая лошадка любого макроса. Читается справа налево: встань в самую нижнюю ячейку колонки A (строка номер Rows.Count, это 1 048 576) и нажми Ctrl+↑ (End(xlUp)). Курсор прыгнет на последнюю заполненную ячейку — её номер строки и вернётся. Так мы узнаём границу данных, не заглядывая в неё глазами.

Шаг 3. Перенос значений одним присваиванием

Здесь главный трюк урока. Вместо привычной пары Copy / PasteSpecial мы просто приравниваем диапазоны:

wsTarget.Cells(lastDstRow + 1, "A").Resize(rowsToCopy, 5).Value = _
    ws.Range("A2:E" & lastSrcRow).Value

Справа .Value целого диапазона — это не одно число, а двумерный массив всех значений. Слева Resize(rowsToCopy, 5) растягивает ячейку-якорь до прямоугольника ровно того же размера. Excel переносит содержимое одним махом, минуя буфер обмена. Плюсы: работает в разы быстрее, не ломает пользователю его собственный буфер, не тащит за собой чужие форматы, границы и условное форматирование. В свод приезжают чистые значения — ровно то, что нужно для отчёта.

Строка про источник использует ту же идею: присваиваешь одну строку тексту — Excel заливает этим текстом весь диапазон Resize(rowsToCopy, 1). Никакого цикла по строкам.

Шаг 4. Итоги: Formula против FormulaLocal

Мы пишем в ячейку не готовое число, а живую формулу =SUM(D2:D41) — если потом кто-то поправит строку вручную, итог пересчитается сам. Обрати внимание на свойство: .Formula ждёт английские имена функций и запятую как разделитель аргументов, независимо от языка твоего Excel. Русское =СУММ(...) сюда писать нельзя — получишь ошибку 1004. Для русских имён есть отдельное свойство .FormulaLocal, но пользоваться им не стоит: макрос перестанет работать на английском Excel у коллеги. То же правило у форматов: .NumberFormat = "dd.mm.yyyy" — английские коды, .NumberFormatLocal = "ДД.ММ.ГГГГ" — русские. Всегда бери версию без Local.

Как это работает

Макрос устроен как конвейер: подготовить приёмник → пройти источники → посчитать итог → навести красоту. Каждый шаг опирается только на данные, а не на то, где сейчас курсор и какой лист открыт. Отсюда правило, которое отличает надёжный код от хрупкого: не используй Select, Activate и ActiveSheet для работы с данными. Записанный рекордером макрос обязательно будет прыгать по листам, и стоит пользователю кликнуть мышкой во время выполнения — данные улетят не туда. Мы вместо этого держим ссылки на листы в переменных ws и wsTarget и обращаемся к ячейкам напрямую. Activate у нас встречается ровно один раз — в самом конце, чтобы показать человеку результат.

Application.ScreenUpdating = False отключает перерисовку экрана на время работы. На сотне строк разница незаметна, на десяти тысячах — секунды против минут: Excel не тратит время на отрисовку того, что через миг перепишется. Главное — не забыть вернуть True в конце, иначе экран останется «замороженным».

Частые ошибки

Итоги

• For Each ws In ThisWorkbook.Worksheets — цикл по всем листам; новый лист подхватится сам, без правки кода.
• Cells(Rows.Count, "A").End(xlUp).Row — стандартный способ найти последнюю заполненную строку.
• Присваивание диапазон.Value = диапазон.Value переносит данные быстрее и чище, чем Copy/PasteSpecial, и не трогает буфер обмена.
• Resize(строк, колонок) растягивает ячейку-якорь до нужного прямоугольника — так пишут целые блоки за одно действие.
• .Formula и .NumberFormat — английские коды; версии с Local ломают файл у коллег с другой локалью.
• Никаких Select и ActiveSheet в рабочем коде: держи листы в переменных.
• Всегда чисти лист-приёмник перед сборкой и возвращай ScreenUpdating = True в конце.