Макрос объединить все файлы в один excel

Сборка листов из разных книг в одну

Предположим, имеется куча книг Excel, все листы из которых надо объединить в один файл. Копировать руками долго и мучительно, поэтому имеет смысл использовать несложный макрос.

Открываем книгу, куда хотим собрать листы из других файлов, входим в редактор Visual Basic сочетанием клавиш Alt+F11 одноименной кнопкой на вкладке Разработчик (Developer — Visual Basic), добавляем новый пустой модуль (в меню Insert — Module) и копируем туда текст вот такого макроса:

 
Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer

    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
    
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
    
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        importWB.Close savechanges:=False
        x = x + 1
    Wend

    Application.ScreenUpdating = True
End Sub

После этого можно вернуться в Excel и запустить созданный макрос на вкладке Разработчик кнопкой Макросы (Developer — Macros) или нажав Alt+F8. Отобразится диалоговое окно открытия файла, где необходимо указать один или несколько (удерживая Ctrl или Shift) файлов, листы из которых надо добавить к текущей книге — и задача решена!

Ссылки по теме

  • Что такое макросы, куда вставлять код макроса на Visual Basic
  • Автоматическая сборка заданных листов из заданных книг с помощью надстройки PLEX
  • Автоматическая сборка данных с нескольких листов на один итоговый лист с помощью надстройки PLEX

Skip to content

Как быстро объединить несколько файлов Excel

Мы рассмотрим три способа объединения файлов Excel в один: путем копирования листов, запуска макроса VBA и использования инструмента «Копировать рабочие листы» из надстройки Ultimate Suite.

Намного проще обрабатывать данные в одном файле, чем переключаться между многочисленными книгами. Однако объединение нескольких книг Excel в один файл может быть сложным и долгим процессом, особенно если книги, которые вам нужно объединить, содержат много листов. Итак, как подойти к этой проблеме? Вы будете копировать их вручную или с помощью кода VBA? Или вы используете один из специализированных инструментов для объединения файлов Excel? 

Ниже вы найдете несколько хороших способов, позволяющих реализовать объединение.

  • Самое простое — копировать вручную.
  • Объединение файлов Excel при помощи VBA.
  • Как объединить несколько файлов с помощью Ultimate Suite.

Примечание. В этой статье мы рассмотрим, как копировать листы из нескольких книг Excel в одну книгу. Если вы ищете быстрый способ скопировать данные с нескольких листов на один общий лист, вы найдете подробную инструкцию в другой статье: Как объединить несколько листов в один.

Простой метод — копировать листы руками.

Если вам нужно объединить всего пару файлов Excel, вы можете вручную скопировать или переместить листы из одного файла в другой. Вот как это можно сделать:

  1. Откройте книги, которые мы планируем объединить.
  2. Выберите листы в исходной книге, которые вы хотите скопировать в основную книгу.

Чтобы выбрать несколько листов, используйте один из следующих приемов:

  • Чтобы выбрать соседние листы, щелкните вкладку первого, который вы хотите скопировать, нажмите и удерживайте клавишу Shift, а затем щелкните вкладку последнего. Это действие выберет все листы между ними.
  • Чтобы выбрать несмежные, удерживайте клавишу Ctrl и щелкайте вкладку каждого из них по отдельности.
  • Выделив все нужные листы, щелкните правой кнопкой мыши любую из выделенных вкладок и выберите «Переместить» или «Копировать…» .

  1. В диалоговом окне «Перемещение или копирование» выполните следующие действия:
    • В раскрывающемся списке «Переместить выбранные листы в книгу» выберите целевую книгу, в которую вы хотите объединить другие файлы.
    • Укажите, где именно должны быть вставлены вкладки. В нашем случае мы выбираем вариант вставки в конец списка.
    • Установите флажок «Создать копию», если хотите, чтобы исходные данные оставались оригинальном файле.
    • Нажмите ОК, чтобы завершить операцию.

Чтобы объединить вкладки из нескольких файлов Excel, повторите описанные выше шаги для каждой книги отдельно.

Замечание. При копировании листов вручную помните о следующем ограничении, налагаемом Excel: невозможно переместить или скопировать группу листов, если какой-либо из них содержит «умную» таблицу. В этом случае вам придется либо преобразовать таблицу в диапазон, либо использовать один из других методов, не имеющих этого ограничения.

Как объединить файлы Excel с VBA

Если у вас есть несколько файлов Excel, которые необходимо объединить в один файл, более быстрым способом будет автоматизировать процесс с помощью макроса VBA.

Ниже вы найдете код VBA, который копирует все листы из всех файлов Excel, которые вы выбираете, в одну книгу. Этот макрос MergeExcelFiles написан Алексом.

Важное замечание! Макрос работает со следующим ограничением — объединяемые файлы не должны быть открыты физически или находиться в памяти, в буфере обмена. В таком случае вы получите ошибку во время выполнения.

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
 
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
 
    If (vbBoolean <> VarType(fnameList)) Then
 
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
 
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
 
            Set wbkCurBook = ActiveWorkbook
 
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
 
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
 
                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
 
                wbkSrcBook.Close SaveChanges:=False
 
            Next
 
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
 
            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
 
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

Как добавить этот макрос в книгу

Если вы хотите вставить макрос в свою книгу, выполните следующие обычные действия:

  1. нажимать Alt + F11 , чтобы открыть редактор Visual Basic.
  2. Щелкните правой кнопкой мыши ThisWorkbook на левой панели и выберите « Вставить» > « Модуль» в контекстном меню.
  3. В появившемся окне (Окно кода) вставьте указанный выше код.

Более подробная инструкция описана в разделе Как вставить и запустить код VBA в Excel .

Кроме того, вы можете загрузить макрос в файле Excel, открыть его в этой книге (включить выполнение макросов, если будет предложено), а затем переключиться на свою собственную книгу и нажать Alt + F8 для его запуска. Если вы новичок в использовании макросов в Excel, следуйте подробным инструкциям ниже.

Как использовать макрос MergeExcelFiles

Откройте файл Excel, в котором вы хотите объединить листы из других книг, и выполните следующие действия:

  1. Нажмите комбинацию Alt + F8, чтобы открыть окно диалога.
  2. В разделе « Имя макроса» выберите MergeExcelFiles и нажмите «Выполнить».

  1. Откроется стандартное окно проводника, вы выберите одну или несколько книг, которые хотите объединить, и нажмите «Открыть» . Чтобы выбрать несколько файлов , удерживайте нажатой клавишу Ctrl, указывая на их имена.

В зависимости от того, сколько файлов вы выбрали, дайте макросу несколько секунд или минут для их обработки. После завершения всех операций он сообщит вам, сколько файлов было обработано и сколько листов было объединено:

Как объединить несколько файлов с помощью Ultimate Suite.

Если вам не очень комфортно с VBA и вы ищете более простой и быстрый способ объединить файлы Excel, обратите внимание на инструмент «Копирование листов (Copy Sheets)» — одну из более чем 60 функций, включенных в невероятно функциональную программу Ultimate Suite for Excel. Она работает в версиях Excel 2010-2019.

С Ultimate Suite объединение нескольких файлов Эксель в один так же просто, как раз-два-три (буквально, всего 3 быстрых шага). Вам даже не нужно открывать те из них, которые вы хотите объединить. И это могут быть два файла или несколько — не важно.

  1. Открыв главную книгу, перейдите на вкладку «Ablebits Data» и нажмите «Копировать листы (Copy Sheets)» > «Выбранные в одну книгу (Selected Sheets to one workbook)».

  1. В диалоговом окне выберите файлы (а в них — листы), которые вы хотите объединить, и нажмите «Далее (Next)» .

Советы:

  • Чтобы выбрать все листы в определенной книге, просто поставьте галочку в поле рядом с именем книги, и все они в этом файле будут выбраны автоматически.
  • Чтобы объединить листы из закрытых книг, нажмите кнопку «Добавить файлы…» и выберите столько книг, сколько нужно. Это добавит выбранные файлы только в окно копирования, не открывая их в Excel.
  • По умолчанию копируются все данные. Однако, в разных листах можно выбрать разные диапазоны для объединения. Чтобы скопировать только определенную область, наведите указатель мыши на имя вкладки, затем щелкните значок    и выберите нужный диапазон. 
  • При необходимости укажите один или несколько дополнительных параметров и нажмите «Копировать» . На снимке скриншоте а ниже показаны настройки по умолчанию: Вставить все (формулы и значения) и Сохранить форматирование.

Дайте мастеру копирования листов несколько секунд для обработки и наслаждайтесь результатом!

На этой странице есть подробное описание всех возможностей работы мастера копирования.

Чтобы поближе познакомиться с этим и другими инструментами для Excel, вы можете загрузить ознакомительную версию Ultimate Suite.

Итак, я надеюсь, вы получили ответ на вопрос — как быстро объединить несколько файлов Excel в один.

Предположим, имеется куча книг Excel, все листы из которых надо объединить в один файл. Копировать руками долго и мучительно, поэтому имеет смысл использовать несложный макрос.

Открываем книгу, куда хотим собрать листы из других файлов, входим в редактор Visual Basic (ALT+F11), добавляем новый пустой модуль (в меню Insert — Module) и копируем туда текст вот такого макроса:

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer

Application.ScreenUpdating = False ‘отключаем обновление экрана для скорости

‘вызываем диалог выбора файлов для импорта
FilesToOpen = Application.GetOpenFilename _
(FileFilter:=»All files (*.*), *.*», _
MultiSelect:=True, Title:=»Files to Merge»)

If TypeName(FilesToOpen) = «Boolean» Then
MsgBox «Не выбрано ни одного файла!»
Exit Sub
End If

‘проходим по всем выбранным файлам
x = 1
While x <= UBound(FilesToOpen)
Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
importWB.Close savechanges:=False
x = x + 1
Wend

Application.ScreenUpdating = True
End Sub

После этого можно вернуться в Excel и запустить созданный макрос через меню Сервис — Макрос — Макросы (Tools — Macro — Macros) или нажав ALT+F8. Отобразится диалоговое окно открытия файла, где необходимо указать один или несколько (удерживая CTRL или SHIFT) файлов, листы из которых надо добавить к текущей книге.
PE

На чтение 5 мин Опубликовано 07.01.2021

Часто при работе в табличном редакторе происходит так, что необходимая информация располагается на отдельных рабочих листах или же файлах. Перед пользователями встает задача объединения нескольких листов и файлов в единое целое. Можно, конечно, путем копирования ячеек из одного документа и вставки их в другой файл реализовать процедуру объединения, но это неудобно и неэффективно. В статье мы детально рассмотрим несколько эффективных методов, позволяющих реализовать объединение табличных документов в один.

Содержание

  1. Объединение рабочих листов в один в табличном редакторе
  2. Объединение информации в один файл
  3. Объединение файлов при помощи VBA
  4. Заключение

Объединение рабочих листов в один в табличном редакторе

Первоначально рассмотрим такую процедуру, как объединение рабочих листов в один документ. Подробная инструкция выглядит так:

  1. Производим открытие рабочих листов, которые мы планируем объединить в один файл.
  2. Передвигаемся в подраздел, имеющий наименование «Главная». Здесь в блоке команд «Формат» находим элемент под наименованием «Переместить или скопировать лист» и жмем по нему левой клавишей мышки.
  3. В раскрывшемся перечне жмем левой клавишей мышки на кнопку «(новая книга)».
  4. После реализации всех действий жмем на «ОК».
  5. Аналогичные операции необходимо произвести с остальными листами табличного документа.

Объединение информации в один файл

Часто возникают такие ситуации, когда необходимо произвести объединение некоторых фрагментов информации в единый файл. Эта процедура выполняется достаточно легко при помощи инструментов табличного редактора. Самое главное – информация, расположенная в табличках, должна быть заранее отформатирована, чтобы в дальнейшем не тратить огромное количество времени на приведение общей таблички к нормальному внешнему виду. Подробная инструкция выглядит так:

  1. К примеру, у нас есть следующие данные, которые необходимо перенести в один файл. Процесс объединения будет правильно работать только при соблюдении нескольких определенных моментов. Рабочие листики, которые будут проходить процедуру консолидации, должны быть приведены к единому форматированию с идентичными заголовками и форматами информации. Ко всему прочему, объединяемая информация не должна содержать в себе незаполненных строчек и колонок.

kak-obedinit-fajly-excel-v-odin

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

На заметку! Процедуру объединения можно реализовать и на той области, на которой уже находится нужная информация, но так можно запутаться из-за большого количества исходных данных.

  1. На следующем этапе мы передвигаемся в раздел, имеющий наименование «Данные». Найти его можно сверху, в основном меню табличного редактора. Здесь мы находим элемент, имеющий название «Консолидация», и жмем по нему левой клавишей мышки.

kak-obedinit-fajly-excel-v-odin

2
  1. В отобразившемся перечне жмем левой клавишей мышки по элементы «Сумма». Далее вводим координаты ячеек, которые мы планируем объединить.

kak-obedinit-fajly-excel-v-odin

3
  1. Аналогичные действия мы производим и с другой информацией, которую мы планируем объединить в один файл.
  2. После проведения всех необходимых действий жмем на «ОК», чтобы подтвердить внесенные изменения.

kak-obedinit-fajly-excel-v-odin

4

Важно! Этот метод плохо работает с информацией текстового вида. Для более качественного объединения данных в один файл следует воспользоваться следующим методом, подразумевающим использование макросов.

Объединение файлов при помощи VBA

Макросы, прописываемые в VBA, превосходно подходят для реализации процедуры объединения нескольких табличных документов в единый файл. Процедура не такая сложная, как кажется на первый взгляд. Главное – следовать пунктам подробной инструкции:

  1. Первоначально необходимо убедиться в том, что все необходимые табличные документы располагаются в одном месте персонального компьютера.
  2. На следующем этапе необходимо зайти в табличный редактор Эксель и создать в нем новую книгу, которая будет служить инструментом объединения остальных табличных документов.
  3. При помощи специальной комбинации горячих клавиш «Alt+F11» перемещаемся в «Visual Basic».

kak-obedinit-fajly-excel-v-odin

5
  1. Сначала нажимаем на «Вставить», а затем в появившемся перечне жмем левой клавишей мышки на элемент, имеющий наименование «Модуль».
  2. Теперь сюда необходимо написать следующий небольшой код:

 Sub GetSheets()

Path = «ваш путь»

Filename = Dir(Path & «*.xls»)

Do While Filename  «»

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

For Each Sheet In ActiveWorkbook.Sheets

Sheet.Copy After:=ThisWorkbook.Sheets(1)

Next Sheet

Workbooks(Filename).Close

Filename = Dir()

Loop

End Sub

  1. В переменную Path необходимо написать путь к тому месту персонального компьютера, в котором располагаются табличные документы для объединения.
  2. Производим сохранение табличного документа в формате «XLSM», чтобы активировать созданные макросы.
  3. Производим запуск макроса.
  4. Готово! Мы объединили все файлы, находящиеся в папке, в один табличный документ.

Заключение

Мы выяснили, что существует множество способов, позволяющих реализовать объединение нескольких файлов в один табличный документ. Использовать функцию под названием «Консолидация» целесообразно только в том случае, если в файлах содержится только числовая информация, так как функция не способна корректно работать с данными текстового формата. Самый эффективный способ, позволяющий качественно объединить табличный документы в один файл без потери информации, – это использование интегрированного языка программирования «Visual Basic» и активация специальных макросов. Однако каждый пользователь сможет сам подобрать более удобный для себя способ объединения табличных документов.

Оцените качество статьи. Нам важно ваше мнение:

Как быстро объединить несколько файлов Excel

Мы рассмотрим три способа объединения файлов Excel в один: путем копирования листов, запуска макроса VBA и использования инструмента «Копировать рабочие листы» из надстройки Ultimate Suite.

обработать данные в файле намного проще, чем переключаться между книгами. Однако объединение нескольких книг Excel в один файл может быть сложным и трудоемким процессом, особенно если книги, которые необходимо объединить, содержат много листов. Так как же решить эту проблему? Будете ли вы копировать их вручную или с помощью кода VBA? Или вы используете один из специализированных инструментов для объединения файлов Excel? 

Ниже вы найдете несколько хороших способов реализовать слияние.

  • Самый простой — скопировать вручную.
  • Комбинируйте файлы Excel с VBA.
  • Как объединить несколько файлов с Ultimate Suite.

Примечание. В этой статье мы расскажем, как скопировать листы из нескольких книг Excel в одну книгу. Если вы ищете быстрый способ скопировать данные с нескольких листов на общий лист, вы найдете подробные инструкции в другой статье: Как объединить несколько листов в один.

Простой метод — копировать листы руками.

Если вам просто нужно объединить пару файлов Excel, вы можете вручную скопировать или переместить листы из одного файла в другой. Вот как это сделать:

  1. Откройте книги, которые мы планируем объединить.
  2. Выберите листы в исходной книге, которые вы хотите скопировать в основную книгу.

Чтобы выбрать несколько листов, используйте один из следующих приемов:

  • Чтобы выбрать соседние листы, щелкните вкладку первого листа, который вы хотите скопировать, удерживайте нажатой клавишу Shift, затем щелкните вкладку последнего. Это действие выберет все листы между ними.
  • Чтобы выбрать несмежные, удерживайте клавишу Ctrl и щелкайте по каждой вкладке по отдельности.
  • Выделив все листы, щелкните правой кнопкой мыши одну из выделенных вкладок и выберите «Переместить или скопировать…» .

  1. В диалоговом окне «Перемещение или копирование» выполните следующие действия:
    • В раскрывающемся списке «Переместить выбранные листы в книгу» выберите целевую книгу, в которой вы хотите объединить другие файлы.
    • Укажите, где именно должны быть вставлены карты. В нашем случае мы выбираем вариант, который будет включен в конец списка.
    • Установите флажок «Создать копию», если вы хотите, чтобы исходные данные остались в исходном файле.
    • Щелкните ОК, чтобы завершить операцию.

Чтобы объединить вкладки из нескольких файлов Excel, повторите описанные выше шаги для каждой книги отдельно.

Комментарий. При копировании листов вручную помните о следующем ограничении, налагаемом Excel: нельзя перемещать или копировать набор листов, если один из них содержит интеллектуальную таблицу. В этом случае вам нужно будет преобразовать таблицу в диапазон или использовать один из других методов, у которых нет этого ограничения.

Как объединить файлы Excel с VBA

Если у вас есть несколько файлов Excel, которые необходимо объединить в один файл, более быстрый способ — автоматизировать процесс с помощью макроса VBA.

Ниже вы найдете код VBA, который копирует все листы из всех выбранных файлов Excel в книгу. Этот макрос MergeExcelFiles написан Алексом.

Важная заметка! Макрос работает со следующим ограничением: объединяемые файлы не должны быть открыты физически или в памяти, в буфере обмена. В этом случае вы получите ошибку во время выполнения.

Sub MergeExcelFiles () Dim fnameList, fnameCurFile As Variant Dim countFiles, countSheets As Integer Dim wksCurSheet как рабочий лист Dim wbkCurBook, wbkSrcBook как рабочая книга fnameList = Application.GetOpenFilename (FileFilter: = «Microsoft xls», xls); Файлы Excel для объединения «, MultiSelect: = True) If (vbBoolean VarType (fnameList)) Then If (UBound (fnameList)> 0) Then countFiles = 0 countSheets = 0 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set wbkCurBook = ActiveWorkbook для каждого fnameCurFile в fnameList countFiles = countFiles + 1 Set wbkSrcBook = Workbooks.Open (Имя файла: = f ForCurBookS .Sheets countSheets = countFogli.Sheets (wbk.CurBook) NextSheets SaveChaets: = False Next Applicationculation =ScreenUp Application. = xlCalculationBFutomatic & Msgcessed files «& v bCrLf &» Merged «& countSheets &» worksheets «, Title: =» Merge Excel file «End If Else MsgBox» None n selected file «, Title: =» Объединить файл Excel «End If End Sub

Как добавить этот макрос в книгу

Если вы хотите вставить макрос в свою книгу, выполните следующие обычные действия:

  1. нажмите Alt + F11, чтобы открыть редактор Visual Basic.
  2. Щелкните правой кнопкой мыши ThisWorkbook на левой панели и выберите в контекстном меню «Вставка»> «Форма.
  3. В появившемся окне (Окно кода) вставьте указанный выше код.

Более подробные инструкции см. В разделе Как вставить и запустить код VBA в Excel .

Кроме того, вы можете загрузить макрос в файл Excel, открыть его в этой книге (при необходимости включить выполнение макроса), затем перейти к своей книге и нажать Alt + F8, чтобы запустить его. Если вы новичок в использовании макросов в Excel, следуйте подробным инструкциям ниже.

Как использовать макрос MergeExcelFiles

Откройте файл Excel, в котором вы хотите объединить листы из других книг, и выполните следующие действия:

  1. Нажмите Alt + F8, чтобы открыть диалоговое окно.
  2. В разделе «Имя макроса» выберите MergeExcelFiles и нажмите «Выполнить».

  1. Откроется стандартное окно проводника, выберите одну или несколько книг, которые вы хотите объединить, и нажмите «Открыть». Чтобы выбрать несколько файлов, удерживайте клавишу Ctrl при вводе их имен.

В зависимости от того, сколько файлов вы выбрали, дайте макросу несколько секунд или минут на их обработку. После выполнения всех операций он сообщит вам, сколько файлов было обработано и сколько листов было объединено:

Как объединить несколько файлов с помощью Ultimate Suite.

Если вам не очень нравится VBA и вы ищете более простой и быстрый способ объединить файлы Excel, воспользуйтесь инструментом Копирование листов, одной из более чем 60 функций, включенных в потрясающий Ultimate Suite for Excel. Работает в версиях Excel 2010-2019.

С Ultimate Suite объединить несколько файлов Excel в один так же просто, как один-два-три (буквально 3 быстрых шага). Вам даже не нужно открывать те, которые хотите объединить. И это может быть два и более файла, неважно.

  1. Открыв главную бухгалтерскую книгу, перейдите на вкладку «Данные» в Ablebits и нажмите Копировать листы> Выбранные листы в книге)».

  1. В диалоговом окне выберите файлы (а в них — листы), которые хотите объединить, и нажмите «Далее)» .

Совет:

  • Чтобы выбрать все листы в определенной книге, просто установите флажок рядом с названием книги, и все они в этом файле будут выбраны автоматически.
  • Чтобы объединить закрытые книжные листы, нажмите кнопку «Добавить файлы…» и выберите все нужные книги. Это только добавит выбранные файлы в окно копирования, но не откроет их в Excel.
  • По умолчанию все данные копируются. Однако на разных листах вы можете выбрать разные диапазоны для объединения. Чтобы скопировать только определенную область, наведите указатель мыши на название вкладки, затем щелкните значок и выберите нужный диапазон. 
  • При необходимости укажите один или несколько дополнительных параметров и нажмите «Копировать». На следующем снимке экрана показаны настройки по умолчанию: Вставить все (формулы и значения) и Сохранить форматирование.

Дайте мастеру копирования несколько секунд на обработку и наслаждайтесь результатом!

Эта страница содержит подробное описание всех функций мастера копирования.

Чтобы ближе познакомиться с этим и другими инструментами Excel, вы можете загрузить пробную версию Ultimate Suite.

Итак, я надеюсь, что у вас есть ответ на свой вопрос: как быстро объединить несколько файлов Excel в один.

This macro for Microsoft Excel allows you to combine multiple workbooks and worksheets into one new workbook and worksheet. When the macro runs, it prompts you to select which excel files from your computer you would like to combine and, once you select them and press ok, this macro will pull data from pre-specified worksheets in the selected workbooks and then combine the data onto one worksheet within a new excel workbook. This works quickly and easily and does not require the hard-coding of file names into the macro.

Note: This macro goes into a Module. Also, you will need to change some cell references and worksheet references if you want the macro to work for your specific needs.

Change the number in this line of code With mybook.Worksheets(1) to choose which worksheet you want data to be copied from in the workbook. 1 means the first sheet and 2 the second sheet etc.

Change the cell references in this line of code Set sourceRange = .Range(«A1:A25») to the cells you want to be copied from the old worksheet onto the new worksheet.

Change the column reference in this line of code Set destrange = BaseWks.Range(«A» & rnum) which is now «A» to whatever column you would like the cells to be imported.

Change this line of code to point to a specific directory where you want the macro to point by default ChDirNet «C:».

Where to install the macro:  Module

Excel Macro to Combine Multiple Workbooks into One

Private Declare Function SetCurrentDirectoryA Lib _
     "kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
    SetCurrentDirectoryA szPath
End Sub
Sub Combine_Workbooks_Select_Files()
    Dim MyPath As String
    Dim SourceRcount As Long, Fnum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim SaveDriveDir As String
    Dim FName As Variant     With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With     SaveDriveDir = CurDir
    ChDirNet "C:"     FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                        MultiSelect:=True)
    If IsArray(FName) Then
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1
        For Fnum = LBound(FName) To UBound(FName)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(FName(Fnum))
            On Error GoTo 0
            If Not mybook Is Nothing Then
                On Error Resume Next
                With mybook.Worksheets(1)
                    Set sourceRange = .Range("A1:A25")
                End With
                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
        If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0                 If Not sourceRange Is Nothing Then                     SourceRcount = sourceRange.Rows.Count                     If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "Not enough rows in the sheet. "
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else
                        Set destrange = BaseWks.Range("A" & rnum)
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value                         rnum = rnum + SourceRcount
                    End If
                End If
                mybook.Close savechanges:=False
            End If
        Next Fnum
        BaseWks.Columns.AutoFit
    End If
ExitTheSub:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
    ChDirNet SaveDriveDir
End Sub


Excel VBA Course

Excel VBA Course — From Beginner to Expert

200+ Video Lessons
50+ Hours of Instruction
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Similar Content on TeachExcel

Guide to Combine and Consolidate Data in Excel

Tutorial: Guide to combining and consolidating data in Excel. This includes consolidating data from …

Combine Worksheets from Multiple Workbooks into One

: Excel macro that allows you to select multiple workbooks and have all of their worksheets …

Combine Data from Multiple Worksheets in Excel

Tutorial:
The easiest way to combine and consolidate data in Excel.

Simple method to combine data …

Combine Values from Multiple Cells into One Cell in Excel

Tutorial: There are two easy ways to combine values from multiple cells in Excel.
In order to do thi…

Vlookup Across Multiple Workbooks

Tutorial: How to use the VLOOKUP function across multiple workbooks in Excel. This will create a lin…

Combine Multiple Chart Types in Excel to Make Powerful Charts

Tutorial: In this tutorial I am going to show you how to combine multiple chart types to create a si…

How to Install the Macro

  1. Select and copy the text from within the grey box above.
  2. Open the Microsoft Excel file in which you would like the Macro to function.
  3. Press «Alt + F11» — This will open the Visual Basic Editor — Works for all Excel Versions.
     Or For other ways to get there, Click Here.
  4. On the new window that opens up, go to the left side where the vertical pane is located. Locate your Excel file; it will be called VBAProject (YOUR FILE’S NAME HERE) and click this.
  5. If the Macro goes in a Module, Click Here, otherwise continue to Step 8.
  6. If the Macro goes in the Workbook or ThisWorkbook, Click Here, otherwise continue to Step 8.
  7. If the Macro goes in the Worksheet Code, Click Here, otherwise continue to Step 8.
  8. Close the Microsoft Visual Basic Editor window and save the Excel file. When you close the Visual Basic Editor window, the regular Excel window will not close.
  9. You are now ready to run the macro.

В случаях, когда требуется выполнить однотипные операции с большим количеством файлов Excel (будь то сбор данных или внесение изменений) проще всего использовать скрипт Excel-VBA. В статье приведены примеры таких скриптов и пошагово объяснёна их работа.

Для того, чтобы перебрать все файлы .xls и .xlsx в папке C:/Folder/ можно использовать следующий код:

sFolder = "C:/Folder/"
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

sFiles = Dir(sFolder & "*.xls*")

Do While sFiles <> ""
Workbooks.Open sFolder & sFiles

'what to do in each file

ActiveWorkbook.Close False

'write data

sFiles = Dir
Loop

В первом блоке мы задаём целевую папку и добавляем разделительный символ к адресу в случае, если мы забыли его указать. Это делается по причине того, что чаще всего мы копируем путь из проводника и там этот символ в конце отсутствует.

sFolder = "C:/Folder/"
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

Следующая команда открывает первый файл, находящийся в целевой папке. Для того, чтобы был открыт именно файл Excel  мы прописываем в качестве аргумента соединение двух строк: sFolder & «.xls*». Звёздочки в данном случае интерпретируются как любое количество любых символов. Таким образом мы открываем все файлы, оканчивающиеся на .»xls»+ любые другие символы. Если нам было бы нужно перебрать только файлы с определёнными символами в имени, то аргумент мог бы выглядеть так:  sFolder &»*Шаблон_имени_файла*»& «.xls*»

sFiles = Dir(sFolder & "*.xls*")

В заключительной части мы перебираем все остальные файлы, попадающие под заданный шаблон:

Do While sFiles <> ""
Workbooks.Open sFolder & sFiles

'what to do in each file

ActiveWorkbook.Close False

'write data

sFiles = Dir
Loop

Очевидно, что перебор осуществляется с помощью цикла While. Цикл работает пока переменная sFiles не будет равна пустой строке «». Предпоследняя строка — повторное использование функции Dir без аргумента присваивает переменной sFiles название пути и имени следующего файла, имя которого соответствует шаблону. В случае, если под заданный шаблон не больше не попадает файлов, переменная функция Dir присваивает переменной sFiles значение «», что приводит к остановке цикла.

Иногда нужные данные Microsoft Excel разбиваются на несколько листов или даже файлов. Может быть намного удобнее хранить всю эту информацию в одном документе.

Вы можете скопировать и вставить нужные ячейки в крайнем случае, разместив их все на одном листе. Однако, в зависимости от того, с каким объемом данных вы работаете, это может занять много времени и усилий.

Вместо этого рассмотрите несколько более разумных способов решения той же задачи. Эти методы могут просто позволить вам пропустить часть напряженной работы, когда дело доходит до объединения листов или файлов в Excel.

В Excel легко объединить несколько листов в новую книгу. Объедините листы, создав новую книгу:

  1. Откройте листы, которые хотите объединить.
  2. Щелкните Главная > Формат > Переместить или скопировать лист .
  3. В раскрывающемся меню выберите (новая книга) .
  4. Щелкните ОК .

Как объединить листы в Excel в один файл

Самый простой способ объединить листы в Excel – использовать команду « Переместить» или «Копировать лист» . Этот метод объединения листов в Excel имеет свои ограничения, но он быстрый и простой.

Сначала откройте листы, которые хотите объединить в одну книгу. Оттуда:

  1. Направляйтесь домой
  2. Щелкните Форматировать
  3. Выберите переместить или скопировать лист

Вы должны увидеть элементы управления, указывающие, куда переместить выбранные листы и порядок этих листов.

В раскрывающемся списке выберите (новая книга) . Это будет основная электронная таблица, куда вы отправите все свои отдельные листы. Вы можете использовать поле Перед листом, чтобы указать порядок расположения листов.

Повторите этот процесс с остальными листами, которые хотите объединить. Затем сохраните новый составной документ.

Объединить данные Excel на один лист

Иногда вам может понадобиться взять несколько наборов данных и представить их на одном листе. Это довольно легко сделать в Excel, если вы заранее позаботитесь о том, чтобы ваши данные были правильно отформатированы .

Для правильной работы этого процесса есть два важных условия. Во-первых, объединяемые листы должны иметь точно такой же макет, с идентичными заголовками и типами данных. Во-вторых, не может быть пустых строк или столбцов.

Когда вы разместите свои данные в соответствии с этими спецификациями, создайте новый рабочий лист. Можно запустить процедуру консолидации на существующем листе, где уже есть данные, но этого проще не делать.

На этом новом листе перейдите на вкладку « Данные » и нажмите « Консолидировать» . В раскрывающемся списке выберите « Сумма», а затем нажмите кнопку в поле « Ссылка», чтобы открыть электронную таблицу и выбрать нужные данные.

Чтобы добавить следующий набор данных, нажмите « Добавить», а затем таким же образом выберите данные. Сделайте это для всех наборов данных, которые вы хотите объединить. Вы даже можете рисовать из других книг, используя кнопку « Обзор» , которая в версии Excel для Mac является « Выбрать» .

Установите флажок « Создать ссылки на исходные данные», если вы собираетесь продолжать обновлять данные на других листах и ​​хотите, чтобы этот лист отражал это. Вы также можете выбрать, какие метки переносятся, с помощью флажков Использовать метки в флажках, как показано выше.

Наконец, нажмите ОК .

К сожалению, этот процесс не подходит для объединения двух листов Excel, если вы хотите объединить ячейки с текстом в них. Работает только с числовыми данными. В ситуации, связанной с текстом, вам нужно будет использовать VBA для объединения листов Excel.

Как объединить таблицы Excel с VBA

Если вы хотите мгновенно объединить листы в Excel из нескольких книг, лучший способ – написать простой макрос VBA. Это будет особенно удобно, если вы будете выполнять эту задачу регулярно.

Во-первых, убедитесь, что все файлы, которые вы хотите объединить, находятся в одной папке на вашем компьютере. Затем создайте новую электронную таблицу Excel, которая объединит их всех.

Перейдите на вкладку Разработчик и выберите Visual Basic . Щелкните Вставить> Модуль .

Чтобы узнать, как объединить два листа Excel с помощью макроса VBA, мы проконсультировались с ExtendOffice . Скопируйте и вставьте следующий код:

 Sub GetSheets()
Path = "C:[PATH TO FILES]"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Не забудьте изменить путь к месту хранения файлов на вашем компьютере.

Затем сохраните книгу как файл XLSM, чтобы включить макросы. Затем запустите макрос, и вы должны обнаружить, что у вас есть одна книга, содержащая все листы из всех файлов в папке.

Связанный: Как копировать формулы в Microsoft Excel

Будьте осторожны перед объединением данных Excel

Объединение листов и файлов в Excel может быть сложным и беспорядочным. Это проливает свет на один из самых важных уроков о Microsoft Excel: всегда хорошо планировать заранее.

Слияние разных наборов данных постфактум всегда вызывает несколько головных болей, особенно если вы работаете с большими электронными таблицами, которые использовались долгое время. Когда вы начинаете работать с новой книгой, лучше всего рассмотреть все возможности того, как вы будете использовать файл в дальнейшем.

Excel отлично подходит для создания документов, к которым вы можете обращаться и использовать в течение длительного периода времени, но решения, принятые на раннем этапе, могут вызвать или предотвратить проблемы позже. Как говорится, унция профилактики.

0 / 0 / 0

Регистрация: 06.12.2011

Сообщений: 9

1

Собрать данные из нескольких документов в один

12.12.2012, 16:39. Показов 22479. Ответов 20


Студворк — интернет-сервис помощи студентам

Доброго времени суток, я сам начинающий, и у меня вопрос, как сделать обработку, например бат файл, чтобы он собирал все файлы в один, или указываешь на какой то определенный каталог(папку) и он берет из нее EXCEL файлы и собирает в один EXCEL — файл.Заранее спасибо!



0



5468 / 1148 / 50

Регистрация: 15.09.2012

Сообщений: 3,514

12.12.2012, 17:06

2

Новичёк1000000, сначала нужно уточнить:

  1. или в самом коде или с помощью диалогового окна вы указываете, из какой папки обрабатывать книги Excel. Нужно учесть: обрабатывать книги во вложенных папках или нет;
  2. как вы собираетесь добавлять данные в книгу-сборник — просто данные заносить на лист или листы переносить.



0



Новичёк1000000

0 / 0 / 0

Регистрация: 06.12.2011

Сообщений: 9

13.12.2012, 09:34

 [ТС]

3

Скрипт, я думаю макрос с этим справится, если его написать на VBA, похожий нашел, но необходимо немного изменить под требования
1. все файлы собираться должны на одном листе (а не добавлять листы в книгу)
2. копирование записей должно начинаться с 2-ой строчки (не добавлять шапку при многократном переносе информации)
3. желательно кнопку вывести для того чтобы (этот факт не важен)
можете подсказать как, или описать(выложить) готовый пример…

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    FilesToOpen = Application.GetOpenFilename _
                  (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
                   MultiSelect:=True, Title:="Files to Merge")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        GoTo ExitHandler
    End If
    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        x = x + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

(она работает, только листы добавляет, а надо чтобы все в один писала)



0



Казанский

15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

14.12.2012, 10:05

4

Приведу свой код 2007 года с другого форума.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub FiziK()
 
Const strStartDir = "c:test" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:testresult" 'папка, в которую будет предложено сохранить результат
Const blInsertNames = True  'вставлять строку заголовка (книга, лист) перед содержимым листа
 
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
    i As Integer, stbar As Boolean, clTarget As Range
 
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application    'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
    .ScreenUpdating = False
    stbar = .DisplayStatusBar
    .DisplayStatusBar = True
 
For i = 1 To UBound(arFiles)
    .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
    Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
    For Each shSrc In wbSrc.Worksheets
        If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
            Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
            If blInsertNames Then
                clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name
                Set clTarget = clTarget.Offset(1, 0)
            End If
            shSrc.UsedRange.Copy clTarget
        End If
    Next
    wbSrc.Close False   'закрыть без запроса на сохранение
Next
    .ScreenUpdating = True
    .DisplayStatusBar = stbar
    .StatusBar = False
 
On Error Resume Next    'если указанный путь не существует и его не удается создать,
                        'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
 
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя
    GoTo save_err
Else
    On Error GoTo save_err
    wbTarget.SaveAs arFiles
End If
End
save_err:
    MsgBox "Книга не сохранена!", vbCritical
End With
End Sub



1



0 / 0 / 0

Регистрация: 21.01.2013

Сообщений: 5

15.05.2013, 14:53

5

Добавлено через 1 минуту
Казанский,

А если необходимо объединить два и более текстовых документа doc в один конечный doc. Эту процедуру запускать из БД access в форме по нажатию кнопки. Пути нахождения документов известны. Конечный документ создается или можно в ранее созданный документ.
Как то я встретил макрос по объединению, но он нарушал структуру содержимого документа. Как исправить так и не разобрался.



0



undefined7

259 / 7 / 1

Регистрация: 22.01.2013

Сообщений: 47

15.05.2013, 21:04

6

я пользуюсь прикреплённым макросом.
но нашёл ещё
2.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Собираем_диапазоны_выбранных_книг_и_всех_листов()
    
    Dim iRng As Range
    Dim iRngAddress As String, oAwb As String, oFile
    Dim lLastRow As Long, lLastRowMyBook As Long
    Dim iLastColumn As Integer
    Dim Str() As String
     
     
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = "*.*"
        .Title = "Выберите файлы"
    If .Show = False Then Exit Sub
    For Each oFile In .SelectedItems
        Workbooks.OpenText fileName:=oFile
        oAwb = Dir(oFile, vbDirectory)
     
        Application.ScreenUpdating = False
        Workbooks(oAwb).Activate
    For Each Sheet In Sheets
        Sheet.Activate
        lLastRow = Cells(1, 1).SpecialCells(xlLastCell).Row
        iLastColumn = Cells(1, 1).SpecialCells(xlLastCell).Column
        lLastRowMyBook = ThisWorkbook.Worksheets(1).Cells(100, 1).SpecialCells(xlLastCell).Row
        iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastRow, iLastColumn)).Address
        Sheet.Range(Cells(1, 1), Cells(lLastRow, iLastColumn)).Copy Destination:=ThisWorkbook.Worksheets(1).Range(iRngAddress)
         
    Next Sheet
        Workbooks(oAwb).Close False
    Next oFile
     
    End With
     
    Application.ScreenUpdating = True
End Sub

Вложения

Тип файла: xls Tips_Macro_Consolidated.xls (49.0 Кб, 321 просмотров)



2



4 / 4 / 0

Регистрация: 18.07.2014

Сообщений: 14

18.07.2014, 14:50

7

Добрый день! Могли бы подсказать, а есть ли аналогичный макрос, только для документов Word, а именно: есть папка с документами, в открытый документ скопировать надпись или строку таблицы из всех документов в этой папке (желательно не открывая документы в папке). Спасибо!



0



0 / 0 / 0

Регистрация: 23.11.2013

Сообщений: 3

15.11.2014, 17:28

8

Здравствуйте!
Столкнулся с проблемой сбора данных с текстовых файлов в книгу Excel.
С всех текстовых файлов в папке нужно, начиная с третьей строки и вниз, перенести в книгу Excel в столбец «А»; затем информацию со второй строки текстовых файлов поместить напротив значений в столбце «А».
Примеры текстовых файлов и шаблон книги Excel в приложении.

Очень прошу помочь.



0



Irbtim

0 / 0 / 0

Регистрация: 13.11.2014

Сообщений: 13

25.03.2015, 13:01

9

Всем Доброго дня,
У меня несколько сложнее задача,
Мне нужно скопировать из разных файлов в один. Проблема в том что файлы не идентичные.
Файл не до конца корректен.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub ww()
Const strStartDir = "C:UsersttDesktop"
Const strSaveDir = "C:UsersttDesktop"
Const blInsertNames = True
Dim a As Integer
Dim b As Integer
 
Dim r As String
r = InputBox("111", "aa")
 
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
    i As Integer, stbar As Boolean, clTarget As Range
On Error Resume Next
ChDir strStartDir
On Error GoTo 0
With Application
arFiles = .GetOpenFilename(FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")
If Not IsArray(arFiles) Then End
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
.ScreenUpdating = False
    stbar = .DisplayStatusBar
    .DisplayStatusBar = True
    
For i = 1 To UBound(arFiles)
    .StatusBar = "12 " & i & " ?? " & UBound(arFiles)
    Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
    For Each shSrc In wbSrc.Worksheets
If IsNull(shSrc.UsedRange.Text) Then
Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
            If blInsertNames Then
clTarget = "" & wbSrc.Name & " -- " & shSrc.Name
                Set clTarget = clTarget.Offset(0, 1)
            End If
            Cells.Find(What:=r, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        a = ActiveCell.Row
        b = ActiveCell.Column
        
            shSrc.Range(a, b).Copy clTarget
        End If
    Next
    wbSrc.Close False
    
Next
    .ScreenUpdating = True
    .DisplayStatusBar = stbar
    .StatusBar = False
On Error Resume Next
 
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("name", "Excel Files (*.xls), *.xls", , "aasd")
End With
End Sub



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

25.03.2015, 13:12

10

Определяете в чём эта неидентичность и как её кодом опознать, для каждой пишите свой вариант обработки.



0



0 / 0 / 0

Регистрация: 13.11.2014

Сообщений: 13

25.03.2015, 14:43

11

В ексель файлах информация находится не одинакова в одних и тех же ячейках, могуть быть выше на строчку, или ниже
Заранее благодарю



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

25.03.2015, 16:30

12

И чем этот код не годится? Только не повторяйтесь



0



Irbtim

0 / 0 / 0

Регистрация: 13.11.2014

Сообщений: 13

25.03.2015, 16:43

13

Друзья,
Я разобрался сам. Выкладываю вам мою версию

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub ww()
Const strStartDir = "C:UsersDesktop"
Const strSaveDir = "C:UsersDesktop"
Const blInsertNames = True
Dim r As String
r = InputBox("Data", "Inputs")
 
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
    i As Integer, stbar As Boolean, clTarget As Range
On Error Resume Next
ChDir strStartDir
On Error GoTo 0
With Application
arFiles = .GetOpenFilename(FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")
If Not IsArray(arFiles) Then End
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
.ScreenUpdating = False
    stbar = .DisplayStatusBar
    .DisplayStatusBar = True
    
For i = 1 To UBound(arFiles)
    .StatusBar = "12 " & i & " ?? " & UBound(arFiles)
    Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
    For Each shSrc In wbSrc.Worksheets
    
 
    
If IsNull(shSrc.UsedRange.Text) Then
Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
            If blInsertNames Then
            Cells.Find(What:=r, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
a = ActiveCell.Row
b = ActiveCell.Column
clTarget = "" & wbSrc.Name
                Set clTarget = clTarget.Offset(0, 1)
            End If
            shSrc.Cells(a, b + 1).Copy clTarget
            
        End If
    Next
    wbSrc.Close False
Next
    .ScreenUpdating = True
    .DisplayStatusBar = stbar
    .StatusBar = False
On Error Resume Next
 
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("name", "Excel Files (*.xls), *.xls", , "????????? ???????????? ?????")
 
If VarType(arFiles) = vbBoolean Then
GoTo save_err
Else
    On Error GoTo save_err
    wbTarget.SaveAs arFiles
End If
End
save_err:
    MsgBox "Not saved", vbCritical
End With
 
End Sub



0



Burnoutman

7 / 7 / 4

Регистрация: 05.04.2012

Сообщений: 147

02.08.2019, 21:08

14

Цитата
Сообщение от Казанский
Посмотреть сообщение

Приведу свой код 2007 года с другого форума.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub FiziK()
 
Const strStartDir = "c:test" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:testresult" 'папка, в которую будет предложено сохранить результат
Const blInsertNames = True  'вставлять строку заголовка (книга, лист) перед содержимым листа
 
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
    i As Integer, stbar As Boolean, clTarget As Range
 
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application    'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
    .ScreenUpdating = False
    stbar = .DisplayStatusBar
    .DisplayStatusBar = True
 
For i = 1 To UBound(arFiles)
    .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
    Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
    For Each shSrc In wbSrc.Worksheets
        If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
            Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
            If blInsertNames Then
                clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name
                Set clTarget = clTarget.Offset(1, 0)
            End If
            shSrc.UsedRange.Copy clTarget
        End If
    Next
    wbSrc.Close False   'закрыть без запроса на сохранение
Next
    .ScreenUpdating = True
    .DisplayStatusBar = stbar
    .StatusBar = False
 
On Error Resume Next    'если указанный путь не существует и его не удается создать,
                        'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
 
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя
    GoTo save_err
Else
    On Error GoTo save_err
    wbTarget.SaveAs arFiles
End If
End
save_err:
    MsgBox "Книга не сохранена!", vbCritical
End With
End Sub

Код отличный,если Запустить в Visual Basic из под Excel,то всё работает,но когда сохраняю в notepad++ в .vbs выдаёт ошибку:

Миниатюры

Собрать данные из нескольких документов в один
 



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

02.08.2019, 23:40

15

Насколько помню — в vbs нет типов переменных.



0



Burnoutman

7 / 7 / 4

Регистрация: 05.04.2012

Сообщений: 147

03.08.2019, 00:15

16

Цитата
Сообщение от Hugo121
Посмотреть сообщение

Насколько помню — в vbs нет типов переменных.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub FiziK()
 
Const strStartDir = "C:UsersBurnoutmanDesktopXLSX"
Const strSaveDir = "C:UsersBurnoutmanDesktopXLSX"
Const blInsertNames = True
 
Dim wbTarget, wbSrc, shSrc, shTarget, arFiles,i, stbar, clTarget
 
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application    'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
    .ScreenUpdating = False
    stbar = .DisplayStatusBar
    .DisplayStatusBar = True
 
For i = 1 To UBound(arFiles)
    .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
    Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
    For Each shSrc In wbSrc.Worksheets
        If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
            Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
            If blInsertNames Then
                clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name
                Set clTarget = clTarget.Offset(1, 0)
            End If
            shSrc.UsedRange.Copy clTarget
        End If
    Next
    wbSrc.Close False   'закрыть без запроса на сохранение
Next
    .ScreenUpdating = True
    .DisplayStatusBar = stbar
    .StatusBar = False
 
On Error Resume Next    'если указанный путь не существует и его не удается создать,
                        'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
 
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя
    GoTo save_err
Else
    On Error GoTo save_err
    wbTarget.SaveAs arFiles
End If
End
save_err:
    MsgBox "Книга не сохранена!", vbCritical
End With
End Sub

Строка:14
Символ:30
Ошибка:Предполагается наличие инструкции.



0



7 / 7 / 4

Регистрация: 05.04.2012

Сообщений: 147

03.08.2019, 09:10

17

Пофиг на этот vbs. Как изменить код так, чтобы информация сохранялась в этот же файл excel из которого запускается макрос, а не предлагала сохранить в новый?



0



Hugo121

6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

03.08.2019, 20:08

18

строка 15:

Visual Basic
1
Set wbTarget = thisworkbook

Ну и после строки 44 до строки 56 всё удалить. Можно дописать сохранение wbTarget, а можно и не дописывать. сохранить вручную если нужно.



1



0 / 0 / 0

Регистрация: 01.09.2020

Сообщений: 11

13.04.2022, 13:46

19

Здравствуйте.
Скажите, как в первом макросе сделать так, что бы файлы .xls выбирались автоматически, из той папки где запущен макрос.
А в этом макросе он предлагает выбрать проводником.



0



811 / 465 / 181

Регистрация: 09.03.2009

Сообщений: 1,577

13.04.2022, 20:43

20

Сделать цикл Dir или FSO.



0



Понравилась статья? Поделить с друзьями:
  • Макрос поиска в excel по первым буквам
  • Макрос отправки на печать excel
  • Макрос объединить все листы в один excel макрос
  • Макрос поиска в excel на vba
  • Макрос отправка писем excel кому