Объединение книг Excel через VBA

Экран ноутбука с отображённым кодом

К чему подходит этот метод

Быстрая консолидация множества книг Excel со схожей структурой листов и колонок.
Подходит, если нужно агрегировать сырые таблицы (без сложных сводных таблиц и формул с внешними ссылками).

Важно: макрос рассчитан на единообразные исходные файлы (одинаковая структура колонок). Для разных структур потребуются дополнительные правила объединения или предварительная нормализация.

Необходимые исходные условия

Одна рабочая книга для макроса (файл с кодом, .xlsm).
Одна рабочая книга «Consolidation», куда будут копироваться данные.
Папка (например, Consolidation) с исходными книгами, которые нужно объединить.
Все файлы должны быть закрытыми при запуске макроса (рекомендуется).

Оригинальный VBA-код (вставьте в редактор VBA: Alt+F11)

    Sub openfiles()


'declare the variables used within the VBA code


Dim MyFolder As String, MyFile As String, wbmain As Workbook, lastrow As Long


'disable these functions to enhance code processing


With Application

.DisplayAlerts = False

.ScreenUpdating = False

End With


'change the path of the folder where your files are going to be saved


MyFolder = InputBox("Enter path of the Consolidation folder") & "\"


'define the reference of the folder in a macro variable


MyFile = Dir(MyFolder)


'open a loop to cycle through each individual workbook stored in the folder


Do While Len(MyFile) > 0


'activate the Consolidation workbook


Windows("Consolidation").Activate


'calculate the last populated row


Range("a1048576").Select

Selection.End(xlUp).Select

ActiveCell.Offset(1, 0).Select


'open the first workbook within the Consolidation folder


Workbooks.Open Filename:=MyFolder & MyFile


Windows(MyFile).Activate


'toggle through each sheet within the workbooks to copy the data


Dim ws As Worksheet

For Each ws In Sheets

   
   ws.Activate
   ws.AutoFilterMode = False
   
   'ignore the header and copy the data from row 2
   If Cells(2, 1) = "" Then GoTo 1
   
   

   GoTo 10
   
   
1: Next


10: Range("a2:az20000").Copy


Windows("Consolidation").Activate


'paste the copied contents


ActiveSheet.Paste


Windows(MyFile).Activate


'close the open workbook once the data is pasted


ActiveWorkbook.Close


'empty the cache to store the value of the next workbook


MyFile = Dir()


'open the next file in the folder


Loop


'enable the disabled functions for future use


With Application

.DisplayAlerts = True

.ScreenUpdating = True

End With




End Sub

Пошаговое объяснение кода

Sub openfiles(): начало подпрограммы. Название можно поменять, но лучше использовать осмысленное.
Dim …: объявление переменных. MyFolder — путь к папке, MyFile — имя файла в цикле.
Application.DisplayAlerts и .ScreenUpdating отключаются для увеличения скорости и предотвращения всплывающих окон.
MyFolder = InputBox(…): пользователь вводит путь к папке. Макрос перебирает файлы с помощью Dir(MyFolder).
Для каждой книги макрос активирует книгу Consolidation, вычисляет следующую пустую строку, открывает источник, проходит по листам, копирует диапазон A2:AZ20000 и вставляет в Consolidation.
После вставки исходная книга закрывается, цикл продолжается.

Что важнее понимать о текущем коде

Диапазон копирования жёстко задан: A2:AZ20000. Если у вас больше колонок или других границ, код нужно изменить.
Код предполагает, что все листы в книгах имеют заголовки в первой строке и данные начинаются со второй строки.
Если лист пустой (Cell(2,1) = “”), он пропускается.
Использование Windows(“Consolidation”).Activate предполагает, что книга с точным именем “Consolidation” уже открыта.

Улучшения и надёжный вариант кода (рекомендуется)

Ниже — более устойчивый и понятный вариант кода с проверками на ошибки, динамическим определением последнего столбца и безопасным открытием/закрытием файлов.

Sub ConsolidateWorkbooks()
    Dim folderPath As String
    Dim fileName As String
    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim ws As Worksheet
    Dim destWS As Worksheet
    Dim lastDestRow As Long
    Dim lastCol As Long
    Dim copyRange As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    On Error GoTo Cleanup

    folderPath = InputBox("Введите полный путь к папке Consolidation:")
    If folderPath = "" Then GoTo Cleanup
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

    Set wbDest = Workbooks("Consolidation") 'Откройте книгу Consolidation заранее
    Set destWS = wbDest.Sheets(1) 'Измените при необходимости

    fileName = Dir(folderPath & "*.xls*")
    Do While fileName <> ""
        Set wbSource = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        For Each ws In wbSource.Worksheets
            'Определяем последнюю заполненную строку в листе-источнике
            If Application.WorksheetFunction.CountA(ws.Cells) > 0 Then
                lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
                'Если данных нет ниже заголовка, пропустить
                If ws.Cells(2, 1).Value <> "" Then
                    lastDestRow = destWS.Cells(destWS.Rows.Count, 1).End(xlUp).Row
                    If lastDestRow > 1 Or destWS.Cells(1, 1).Value <> "" Then
                        lastDestRow = lastDestRow + 1
                    Else
                        lastDestRow = 1
                    End If
                    Set copyRange = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, lastCol).End(xlUp))
                    If Application.WorksheetFunction.CountA(copyRange) > 0 Then
                        copyRange.Copy destWS.Cells(lastDestRow, 1)
                    End If
                End If
            End If
        Next ws
        wbSource.Close SaveChanges:=False
        fileName = Dir()
    Loop

Cleanup:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Ошибка: " & Err.Description, vbExclamation
End Sub

Полезные улучшения в этом варианте:

Динамическое определение последнего столбца и диапазона для копирования.
Защита от попытки копировать пустые диапазоны.
Открытие источников в режиме ReadOnly и закрытие без сохранения.
Включены проверки и обработка ошибок.

Варианты использования и альтернативы

Power Query (Получить и преобразовать данные): если у вас Excel 2016+, Power Query удобен для импорта множества файлов из папки и автоматического объединения с возможностью трансформации. Подходит при разной структуре — легче настроить правила объединения.
Использование Python (pandas, openpyxl): удобно при сложной предобработке, большом объёме данных или интеграции с базами данных.
Написание надёжного Add-in на VBA/COM: для повторяющихся задач с GUI и логированием.

Когда VBA не подойдёт:

Файлы имеют полностью разную структуру или разные наборы колонок и требуется логика сопоставления столбцов.
Данные содержат внешние ссылки, формулы, которые нужно сохранить при объединении.
Объём данных очень большой (миллионы строк) — лучше использовать базу данных или Power Query/ETL-процессы.

Практическая методология (микро-SOP)

Подготовка: создайте папку Consolidation и поместите туда все .xlsx/.xlsm файлы. Закройте их.
Откройте Excel, создайте книгу Consolidation и сохраните её как .xlsm.
Откройте редактор VBA (Alt+F11) и вставьте улучшенный код.
Проверьте: на одной тестовой подгруппе файлов убедитесь, что данные копируются корректно.
Запустите макрос, проверьте результаты, сохраните Consolidation.
Логирование: при необходимости добавьте запись имен обработанных файлов в отдельный лист.

Чеклист перед запуском

Убедиться, что все файлы имеют одинаковую структуру колонок.
Закрыть все исходные файлы.
Открыть книгу Consolidation и убедиться в её названии и активном листе назначения.
Сделать резервную копию Consolidation перед массовым запуском.
Тест на 3–5 файлах перед полной обработкой.

Критерии приёмки

Все строки из исходных файлов присутствуют в Consolidation без потерь.
Заголовки не продублированы в середине данных (копируется только с 2-й строки).
Формулы, которые должны остаться формулами, не были перезаписаны значениями, если это важно.
Отчёт о количестве обработанных файлов совпадает с количеством файлов в папке.

Варианты отладки и частые ошибки

Ошибка: “Subscript out of range” при Set wbDest = Workbooks(“Consolidation”). Убедитесь, что книга открыта и названа именно так.
Пустые строки между блоками данных: проверьте логику определения lastDestRow.
Пропуск листов: если в книге есть скрытые или системные листы, явно фильтруйте по имени или Visible = xlSheetVisible.

Безопасность и приватность

Макросы (.xlsm) могут запускать код — используйте файлы из надежных источников.
Если данные содержат персональные данные (PII), храните Consolidation в защищённом месте и рассмотрите шифрование файла.
При работе в корпоративной сети согласуйте выполнение макросов с политиками безопасности ИТ.

Модель принятия решения: когда использовать VBA vs Power Query vs СУБД

VBA: хорош для автоматизации простых, повторяющихся задач с предсказуемой структурой.
Power Query: лучший выбор для гибкой обработки и трансформаций без кода.
СУБД/ETL: при больших объёмах и необходимости постоянной интеграции данных.

Короткая галерея возможных доработок (edge-cases)

Разные заголовки: добавить сопоставление колонок по названию.
Форматирование и формулы: вместо Copy используйте Value = Value для вставки только значений или PasteSpecial.
Локализация разделителей/дат: учесть региональные настройки Excel при импорте CSV.

Фрагмент кода Excel VBA, демонстрация логики копирования

Резюме и рекомендации

Для быстрой консолидации однотипных файлов стандартный VBA-скрипт работает хорошо, но желательно использовать улучшённую версию с проверками.
Для разнообразных структур или больших объёмов лучше выбрать Power Query или перенос данных в СУБД.
Всегда тестируйте макросы на небольшом наборе данных и делайте резервные копии.

Диаграмма процесса: папка -> источники -> макрос -> Consolidation