Макрос для объединения Excel-файлов из папки

Результат: макрос просит выбрать папку, очищает лист Итог, последовательно открывает .xlsx, копирует строки с первого листа и добавляет имя исходного файла. Он не изменяет входные книги. Для регулярно меняющейся структуры сначала рассмотрите Power Query: VBA оправдан, если требуется дополнительная логика и управляемый выпуск результата.

Условия для безопасного объединения

Во всех входных книгах должна быть одна строка заголовков и одинаковый порядок колонок. Итоговую книгу храните вне обрабатываемой папки либо исключайте ThisWorkbook.Name. Перед запуском сделайте копию: макрос очищает прежний лист результата.

Рабочий код

Option Explicit

Sub MergeFolderFiles()
    Dim picker As FileDialog, folderPath As String, fileName As String
    Dim srcBook As Workbook, srcSheet As Worksheet, dst As Worksheet
    Dim lastRow As Long, lastCol As Long, nextRow As Long

    Set dst = ThisWorkbook.Worksheets("Итог")
    Set picker = Application.FileDialog(msoFileDialogFolderPicker)
    If picker.Show <> -1 Then Exit Sub
    folderPath = picker.SelectedItems(1) & Application.PathSeparator

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo Fail
    dst.Cells.Clear
    nextRow = 1
    fileName = Dir(folderPath & "*.xlsx")

    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name Then
            Set srcBook = Workbooks.Open(folderPath & fileName, ReadOnly:=True, UpdateLinks:=False)
            Set srcSheet = srcBook.Worksheets(1)
            lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
            lastCol = srcSheet.Cells(1, srcSheet.Columns.Count).End(xlToLeft).Column
            If lastRow >= 2 Then
                If nextRow = 1 Then
                    srcSheet.Cells(1, 1).Resize(1, lastCol).Copy dst.Cells(1, 1)
                    dst.Cells(1, lastCol + 1).Value = "Источник"
                    nextRow = 2
                End If
                srcSheet.Cells(2, 1).Resize(lastRow - 1, lastCol).Copy dst.Cells(nextRow, 1)
                dst.Cells(nextRow, lastCol + 1).Resize(lastRow - 1, 1).Value = fileName
                nextRow = nextRow + lastRow - 1
            End If
            srcBook.Close SaveChanges:=False
        End If
        fileName = Dir
    Loop

CleanExit:
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
Fail:
    If Not srcBook Is Nothing Then srcBook.Close SaveChanges:=False
    MsgBox "Ошибка в файле " & fileName & ": " & Err.Description, vbExclamation
    Resume CleanExit
End Sub

Что проверить в коде под свою структуру

Сейчас используется первый лист и ключевой столбец A. Если заголовок начинается не в строке 1, имеются служебные итоги или файлы .xlsm, алгоритм нужно адаптировать. Нельзя просто расширить маску на все форматы: итоговая книга и временные файлы ~$ должны исключаться.

Контроль схемы

Production-версия сравнивает заголовки каждого файла с эталоном и не копирует несовместимую книгу. Ошибка должна попасть в журнал с именем файла, а обработка следующих файлов — продолжиться. Пример выше останавливается на первой ошибке, чтобы пользователь не получил молча неполный итог.

Почему значения, а не всё оформление

Copy переносит формулы и часть форматов. Для больших объёмов быстрее присваивать массив .Value, но тогда нужно отдельно перенести заголовки и привести типы. Выбор зависит от цели: консолидированный набор обычно должен хранить значения и источник, а не ссылки на закрытые книги.

Когда Power Query лучше

Если файлы одинаковы и нужны повторяемая очистка/объединение, Данные → Получить данные → Из папки даёт прозрачные шаги без макроса. VBA выбирают для сложного выбора листов, журналов, отдельных выходных файлов или интеграции с Word/PDF.

Следующий шаг

Для рабочего инструмента понадобятся проверка схемы, журнал, выбор листа, обработка каждого сбоя и тест на копии. Такая доработка оценивается по реальным обезличенным файлам на странице [автоматизации](/services/excel-automation/).