Как написать VBA-макрос который автоматически собирает данные из всех листов Excel в один сводный отчёт — пошаговый разбор кода, готовый пример и кнопка запуска.
Макрос собирает отчёт из 10 листов Excel за 3 секунды — код и объяснение
Каждый месяц одно и то же. Открываете файл с двенадцатью листами — по одному на каждый месяц или отдел. Копируете данные с первого листа, вставляете в сводную таблицу. Переходите на второй, копируете, вставляете. И так десять, двадцать, тридцать раз.
Если таблица небольшая — минут двадцать. Если большая — час. И каждый раз есть шанс ошибиться: не тот диапазон, пропустили строку, вставили с перекрытием.
Макрос делает это за три секунды. Один запуск — и все данные собраны на одном листе в правильном порядке без единой ручной операции.
В этой статье напишем такой макрос с нуля, разберём каждую строку кода и добавим кнопку запуска прямо на лист.
Как работает сборка данных через VBA
Логика макроса простая. Он перебирает все листы книги по очереди, с каждого берёт нужный диапазон данных и копирует на отдельный сводный лист. После обхода всех листов на сводном оказываются данные из всей книги.
Ключевые вопросы которые нужно решить до написания кода:
Какой лист является сводным? Макрос должен знать куда писать данные. Обычно это отдельный лист с именем «Сводный» или «Итого» — его нужно создать заранее или создавать макросом автоматически.
С каких листов собирать данные? Иногда нужно обойти все листы, иногда — только часть. Сводный лист при этом нужно исключить чтобы макрос не скопировал данные сам в себя.
Где начинаются данные на каждом листе? Если на всех листах одинаковая структура — первая строка заголовок, данные со второй — это упрощает код. Если структура разная — потребуется дополнительная логика.
Нужно ли копировать заголовки? Обычно заголовки копируют один раз с первого листа, а с остальных берут только строки с данными.
Простая версия — собрать все листы в один
Начнём с базового варианта. Макрос обходит все листы кроме сводного, копирует данные начиная со второй строки и добавляет их на сводный лист.
Откройте редактор VBA через Alt+F11. Вставьте новый модуль: правая кнопка на книге → «Вставить» → «Модуль». Введите код:
Sub СобратьДанные()
• Dim wsСводный As Worksheet*
• Dim ws As Worksheet*
• Dim lastRowСводный As Long*
• Dim lastRowЛист As Long*
• Dim rng As Range*
• Application.ScreenUpdating = False*
• Application.Calculation = xlCalculationManual*
• ’ Указываем сводный лист*
• Set wsСводный = Sheets(“Сводный”)*
• ’ Очищаем сводный лист кроме заголовков*
• wsСводный.Rows(“2:” & wsСводный.Rows.Count).ClearContents*
• ’ Копируем заголовки с первого листа*
• Dim firstSheet As Boolean*
• firstSheet = True*
• ’ Обходим все листы*
• For Each ws In ThisWorkbook.Sheets*
' Пропускаем сводный лист*
If ws.Name <> "Сводный" Then*
lastRowЛист = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row*
' Копируем заголовки только с первого листа*
If firstSheet And lastRowЛист >= 1 Then*
ws.Rows(1).Copy wsСводный.Rows(1)*
firstSheet = False*
End If*
' Копируем данные начиная со второй строки*
If lastRowЛист >= 2 Then*
Set rng = ws.Range("A2:A" & lastRowЛист)*
Set rng = ws.Range("A2").Resize(lastRowЛист - 1, ws.UsedRange.Columns.Count)*
lastRowСводный = wsСводный.Cells(wsСводный.Rows.Count, 1).End(xlUp).Row + 1*
rng.Copy wsСводный.Cells(lastRowСводный, 1)*
End If*
End If*
• Next ws*
• Application.ScreenUpdating = True*
• Application.Calculation = xlCalculationAutomatic*
• MsgBox “Готово! Данные собраны на листе ‘Сводный’.”, vbInformation*
End Sub
Перед запуском создайте лист с именем «Сводный» — макрос будет писать данные туда.
Что происходит внутри кода
Разберём каждый блок чтобы вы понимали логику и могли адаптировать код под свою задачу.
Application.ScreenUpdating = False и Application.Calculation = xlCalculationManual — отключаем обновление экрана и пересчёт формул на время работы макроса. На больших файлах это ускоряет работу в несколько раз. В конце кода их нужно включить обратно — иначе Excel останется в «замороженном» состоянии.
Set wsСводный = Sheets(“Сводный”) — привязываем переменную к сводному листу. Если лист называется иначе — измените строку в кавычках.
wsСводный.Rows(“2:” & wsСводный.Rows.Count).ClearContents — очищаем сводный лист перед каждым запуском. Это нужно чтобы при повторном запуске данные не дублировались — старые удаляются, новые записываются заново. Первая строка с заголовками не трогается.
For Each ws In ThisWorkbook.Sheets — цикл по всем листам книги. Переменная ws по очереди принимает значение каждого листа.
If ws.Name <> “Сводный” — условие которое исключает сводный лист из обхода. Без него макрос попытается скопировать данные сам в себя и создаст бесконечный цикл.
lastRowЛист = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row — находим последнюю заполненную строку на текущем листе по первому столбцу. Это стандартный приём VBA для работы с динамическими диапазонами.
ws.Range(“A2”).Resize(lastRowЛист - 1, ws.UsedRange.Columns.Count) — формируем диапазон данных. Начинаем со второй строки, высота равна количеству строк с данными, ширина равна количеству используемых столбцов на листе.
lastRowСводный = wsСводный.Cells(wsСводный.Rows.Count, 1).End(xlUp).Row + 1 — находим первую свободную строку на сводном листе. Плюс единица — чтобы вставить данные после последней заполненной строки, а не поверх неё.
Улучшенная версия — с выбором листов и счётчиком
Базовая версия собирает все листы подряд. Но часто нужно больше контроля: пропустить служебные листы, показать сколько строк собрано, добавить название источника.
Sub СобратьДанныеПлюс()
• Dim wsСводный As Worksheet*
• Dim ws As Worksheet*
• Dim lastRowСводный As Long*
• Dim lastRowЛист As Long*
• Dim rng As Range*
• Dim totalRows As Long*
• Dim skipSheets As String*
• Application.ScreenUpdating = False*
• Application.Calculation = xlCalculationManual*
• ’ Листы которые нужно пропустить — через запятую*
• skipSheets = “,Сводный,Настройки,Справочник,”*
• Set wsСводный = Sheets(“Сводный”)*
• wsСводный.Rows(“2:” & wsСводный.Rows.Count).ClearContents*
• totalRows = 0*
• Dim firstSheet As Boolean*
• firstSheet = True*
• For Each ws In ThisWorkbook.Sheets*
' Проверяем не входит ли лист в список исключений*
If InStr(skipSheets, "," & ws.Name & ",") = 0 Then*
lastRowЛист = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row*
If firstSheet And lastRowЛист >= 1 Then*
ws.Rows(1).Copy wsСводный.Rows(1)*
firstSheet = False*
End If*
If lastRowЛист >= 2 Then*
Set rng = ws.Range("A2").Resize(lastRowЛист - 1, ws.UsedRange.Columns.Count)*
lastRowСводный = wsСводный.Cells(wsСводный.Rows.Count, 1).End(xlUp).Row + 1*
rng.Copy wsСводный.Cells(lastRowСводный, 1)*
totalRows = totalRows + (lastRowЛист - 1)*
End If*
End If*
• Next ws*
• Application.ScreenUpdating = True*
• Application.Calculation = xlCalculationAutomatic*
• MsgBox “Готово! Собрано строк: “ & totalRows & “ из “ & _*
(ThisWorkbook.Sheets.Count - (Len(skipSheets) - Len(Replace(skipSheets, ",", "")) - 1)) & _*
" листов.", vbInformation*
End Sub
Ключевое отличие — переменная skipSheets. В неё через запятую вписываете имена листов которые нужно пропустить. Макрос проверяет каждый лист: если его имя найдено в строке исключений — пропускает, если нет — обрабатывает.
Версия с добавлением столбца-источника
Иногда нужно знать с какого листа пришла каждая строка. Это особенно полезно когда данные из разных отделов или периодов — чтобы в сводной таблице можно было фильтровать по источнику.
Добавим в код один блок после копирования данных:
’ Добавляем название листа в последний столбец
Dim sourceCol As Integer
sourceCol = ws.UsedRange.Columns.Count + 1
Dim i As Long
For i = lastRowСводный To lastRowСводный + (lastRowЛист - 2)
• wsСводный.Cells(i, sourceCol).Value = ws.Name*
Next i
Вставьте этот блок сразу после строки rng.Copy wsСводный.Cells(lastRowСводный, 1) в улучшенной версии. После запуска в сводной таблице появится дополнительный столбец с именем листа-источника для каждой строки.
Как привязать макрос к кнопке
Запускать макрос через Alt+F8 неудобно. Гораздо лучше — кнопка прямо на сводном листе.
Перейдите на вкладку «Разработчик». Нажмите «Вставить» → в разделе «Элементы управления формы» выберите «Кнопка». Нарисуйте кнопку на листе.
В диалоге «Назначить макрос» выберите СобратьДанныеПлюс и нажмите ОК. Переименуйте кнопку: правая кнопка → «Изменить текст» → напишите «Собрать данные».
Теперь один клик — и макрос запущен. Удобно когда файл используют коллеги которые не знают VBA.
Частые ошибки и как их избежать
Ошибка «Subscript out of range». Макрос не нашёл лист «Сводный». Проверьте что лист существует и название написано точно так же как в коде — с учётом пробелов и регистра.
Данные дублируются при повторном запуске. Значит строка очистки сводного листа не работает. Проверьте что wsСводный.Rows(“2:…” ).ClearContents стоит до начала цикла, а не после.
Макрос собирает пустые строки. Случается когда в конце листа есть ячейки с пробелами или скрытым форматированием. Решение — заменить End(xlUp) на цикл с проверкой: не копировать строки где все ячейки пустые.
Формулы в исходных листах теряются. Метод Copy копирует значения и форматирование. Если нужны только значения без формул — замените rng.Copy wsСводный.Cells(lastRowСводный, 1) на:
wsСводный.Cells(lastRowСводный, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Это вставит только значения — без формул, без привязки к исходным листам.
Макрос работает медленно. На файлах с большим количеством листов или строк — добавьте в начало отключение событий: Application.EnableEvents = False. Верните обратно в конце: Application.EnableEvents = True.
Как подготовить файл к работе с макросом
Чтобы макрос работал надёжно, структура данных на всех листах должна быть одинаковой: одинаковые заголовки в первой строке, данные начиная со второй, нет объединённых ячеек в диапазоне данных.
Объединённые ячейки — главный враг автоматической сборки. Если на листах есть объединения в диапазоне данных, макрос либо выдаст ошибку при копировании, либо скопирует данные неправильно. Уберите объединения до запуска.
Если структура листов разная — например на одних листах данные начинаются с первой строки, на других со второй — добавьте проверку в код или приведите структуру к единому виду вручную перед запуском.
Связанные материалы
Этот макрос — часть системы автоматизации Excel. Если хотите научиться писать первые макросы с нуля — в статье Кнопка, которая собирает данные из всех листов Excel в одну таблицу подробный разбор базовых принципов VBA.
А как автоматически находить и подсвечивать ошибки в таблице — в материале Найдите ошибки в Excel одной кнопкой — VBA сам подсветит проблемные ячейки.
Подписывайтесь на Telegram — там короткие гайды, готовые файлы и разборы реальных задач по Excel и VBA: t.me/macroschannel
Итог
Макрос для сборки данных из нескольких листов — один из самых полезных инструментов автоматизации в Excel. Он работает за секунды, не ошибается и запускается одной кнопкой.
Три версии кода в статье закрывают разные сценарии: базовая сборка всех листов, сборка с исключениями и счётчиком строк, добавление столбца с названием источника. Берите ту которая подходит под вашу задачу — и адаптируйте под свою структуру данных.
Главное правило — протестировать на копии файла. Макрос очищает сводный лист перед каждым запуском, и если что-то настроено неправильно — данные будут потеряны.