Хитрости »
Основные понятия (22)Здесь собраны статьи, в которых разъясняются базовые понятия работы в Excel и VBA, а так же проблемы, с которыми сталкивается большинство начинающих
Сводные таблицы и анализ данных (5) Раздел поможет изучить сводные таблицы и научиться их использовать "на полную"
Графики и диаграммы (4) Раздел поможет научиться создавать диаграммы и графики в Excel, в том числе нестандартные
Работа с VB проектом (10) С помощью статей раздела вы научитесь создавать процедуры программно и выполнять различные операции с объектами самого VBA
Power BI и Power Query (5) Здесь собраны статьи, раскрывающие различные возможности мощнейшего инструмента для визуализаций бизнесс-процессов Power BI и надстройки для Excel Power Query
Условное форматирование (5) Этот раздел поможет поближе познакомиться с Условным форматированием на примерах различных ситуаций
Списки и диапазоны (5) Статьи, посвященные работе не только с выпадающими списками, но и с диапазонами и хитростями их применения в рабочих файлах
Макросы(VBA процедуры) (60) Статьи раздела направлены на изучение VBA с детальным разбором кодов. Множество статей с примерами кодов под всевозможные ситуации с комментариями и пояснениями
Разное (36) Собраны статьи, которые не подходят ни под одну из представленных выше категорий или входят сразу в несколько. Но эти статье не менее полезные!

Как собрать данные с нескольких листов или книг?

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

Приведенный выше код необходимо вставить в стандартный модуль(Что такое модуль? Какие бывают модули?). Выполнить его можно будет из этой книги нажатием клавиш Alt+F8. В появившемся окне выбрать Consolidated_Range_of_Books_and_Sheets и нажать Выполнить. Так же можно создать на листе кнопку и назначить ей данный макрос. Так же, если впервые работаете с макросами настоятельно рекомендую прочитать статью: Что такое макрос и где его искать?, а так же Почему не работает макрос?

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

  • Диапазон сбора данных - Если в окне выбора диапазона выбрать только одну ячейку, то данные будут собраны со всех листов книги/книг, начиная с этой ячейки и до последней ячейки листа.
    Если выбрать несколько ячеек, данные будут собраны только с указанного диапазона всех листов книги/книг.
  • Имя листа - Необязателен для указания. Если не указан - данные будут собраны со всех листов. Указать можно как точное соответствие имени листа, так и с частичным соответствием. Например, если в книгах для сбора данных необходимо собрать данные только с листа "Январь", то следует так и указать - "Январь". Если требуется собрать данные только с листов, начинающихся с "Продажи"("Продажи ЮГ", "Продажи НН", "Продажи Запад" и т.д.), то следует применить символ подстановки звездочку - "Продажи*". Если надо собрать с листов, содержащих в имени "продажи"("Итоговые продажи ЮГ", "Продажи НН", "Сезонные продажи" и т.д.), то указываем "*продажи*". Если надо собрать только с листа "Сезонные продажи", но известно, что вместо пробела может быть нижнее подчеркивание или тире("Сезонные продажи", "Сезонные_продажи", "Сезонные-продажи") или иной символ, то можно также применить звездочку - "Сезонные*продажи". Но если среди листов могут встречаться и такие как "Сезонные разовые продажи", "Сезонные корпоративные продажи" и т.п., но информацию с них собирать не надо, то можно применить вопросительный знак - "Сезонные?продажи". Вопросительный знак заменяет любой один символ, звездочка - любое количество любых символов.
  • Далее появится запрос: Вставлять только значения? - если выбрать Да, то в результирующий лист с листов будут вставлены исключительно значения ячеек (без формул, форматов, заливки ячеек, цвета шрифта и т.п.). Может пригодится, если на листах для сбора записаны формулы, ссылающиеся на другие листы, книги, диапазоны. При обычном копировании может случиться так, что формула выдаст ошибку, т.к. в книге для вставки нет таких листов и диапазонов или данные расположены иначе. Если выбрать Нет, то все ячейки с листов на результирующий будут копироваться в точности как в исходных листах.
  • И последний запрос: Собрать данные с нескольких книг? - если выбрать Да, то появится диалоговое окно выбора файлов. Надо указать все файлы, данные с которых необходимо собрать. Если выбрать Нет, то данные будут собираться с листов только активной книги.

Данные будут собраны на новый лист книги с макросом. Если данные собирались с нескольких книг, то в первый столбец будут занесены имена книг, с которых собраны данные.

Если после сбора данных обнаружили, что после каждого файла/листа много пустых строк, то следует найти в коде строку:
lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
и заменить её на строку примерно следующего содержания:
lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
где 1 - это номер столбца на листах данных, в котором искать последнюю заполненную ячейку.
Актуально это для файлов с одинаковой структурой. Например, если сбор идет с листов по продажам, то вполне может быть такое, что в столбце 1 может не быть данных. Поэтому следует определить номер столбца, в котором наполнение данных максимально. Например, это может быть столбец с наименованиями товара или с суммами. Если это столбец D, то следует строку записать так:
lLastrow = .Cells(.Rows.Count, 4).End(xlUp).Row 'ищем последнюю строку в 4-м столбце
Подробнее про определение последней строки можно прочитать в статье: Как определить последнюю ячейку на листе через VBA?

Важное замечание: Если вы используете Excel 2007 и выше и файлы для сбора данных тоже в этом формате, то следует скачанный файл сначала сохранить в формат "Книга Excel с поддержкой макросов(.xlsm)", закрыть и открыт заново. Иначе есть шанс получить ошибку при сборе данных, т.к. Excel будет в режиме совместимости и не сможет поместить на результирующий лист более 65536 строк.

Скачать пример:

  Tips_Macro_Consolidated.xls (50,0 KiB, 22 589 скачиваний)

Также см.:
Сбор данных с нескольких листов/книг
Как объединить несколько текстовых файлов в один?
Просмотреть все файлы в папке
План-фактный анализ в Excel при помощи Power Query


Статья помогла? Не держи в себе, поделись ссылкой с друзьями!

Поиск по меткам

Access Multex Outlook Power BI Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Настройка Печать Поиск данных Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx вебинар ссылки статьи тренинг
Обсуждение: оставлено 286 коммент.
  1. Добрый день, скажите пожалуйста, данные у меня собраны так - http://joxi.ru/BA01zBBtBOg7ar
    Возможно ли добавить название столбцов, и фильтр

  2. Алексей:

    Здравствуйте, Дмитрий!
    Решил воспользоваться Вашим макросом для копирования даных из 475 книг на один лист, но столкнулся с ошибкой VB Run-time eror '1004' (скрин ошибки https://1drv.ms/i/s!AhFACJaqXOEEgoxd8KR-BkJ-pHRAFQ), которая появляется после вставки из 8-ми первых кних. Книгу для вставки сохранял и в .xlsx и .xlsm - не помогло. Исходные файлы в формате .xls, по одному листу в каждой книге с идентичной структурой и размером данных A1:T101. т.е. конечный результат должен иметь 47500 строк данных, а работа скрипта заканчивается на 800...
    Помогите разобратся, пожалуйста!

    • Алексей, а Вы не заметили, что текст ошибки пишет? Ровно то, что книгу не получается открыть. Т.е. метод Open просто не срабатывает. Посмотрите на какой книге останавливается код и изучите книгу. Возможно, она повреждена и не может быть открыта в режиме чтения/записи.

  3. Дмитрий:

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

  4. Леонид:

    Спасибо за полезную статью! Очень пригодилось!

    • Роман:

      Возможно кому пригодится, изменил код. Суть в том, что есть накладные с утвержденной формой. Накладные с разных объектов, которые нужно собрать в одну книгу. Причем, каждое направление(0,1,2,3) на разные вкладки(имя вкладки меняется ручками.

      '---------------------------------------------------------------------------------------
      ' Module : mConsolidated
      ' DateTime : 02.02.2010 17:06
      ' Author : The_Prist(Щербаков Дмитрий)
      ' Purpose : http://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/
      ' Процедура сбора данных с нескольки листов/книг
      '---------------------------------------------------------------------------------------
      Option Explicit

      Sub Consolidated_Range_of_Books_and_Sheets()
      Dim iBeginRange As Object, lCalc As Long, lCol As Long
      Dim oAwb As String, sCopyAddress As String, sSheetName As String
      Dim lLastRow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
      Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
      Dim wbAct As Workbook
      Dim bPasteValues As Boolean
      Dim AWN As String

      On Error Resume Next
      'Выбираем диапазон выборки с книг
      'выбрал диапазон значений таблицы(можно указать только одну ячейку тогда диапазон от этой ячеки до конца данных)
      Set iBeginRange = Range("E14:P252")

      'Указываем имя листа
      'Допустимо указывать в имени листа символы подставки ? и *.
      'Если указать только * то данные будут собираться со всех листов
      sSheetName = "ТТН 1" 'указал имя листа в книге (у меня во всех книгах листы одинаковые

      bPasteValues = vbYes 'вставляет только значения из дапазона

      'Предлагает выбрать книги с которых нужно выбрать данные
      ChDrive Left(ThisWorkbook.Path, 2)
      ChDir ThisWorkbook.Path
      avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
      If VarType(avFiles) = vbBoolean Then Exit Sub
      bPolyBooks = True
      lCol = 1

      'отключаем обновление экрана, автопересчет формул и отслеживание событий
      'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
      With Application
      lCalc = .Calculation
      .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
      End With

      'Указываем на какой лист в текущей книги собирать данные
      Set wsDataSheet = ThisWorkbook.Sheets("0")

      'цикл по книгам
      For li = LBound(avFiles) To UBound(avFiles)
      If bPolyBooks Then
      Set wbAct = Workbooks.Open(Filename:=avFiles(li), UpdateLinks:=False)
      Else
      Set wbAct = ThisWorkbook
      End If
      oAwb = wbAct.Name
      'цикл по листам
      For Each wsSh In wbAct.Sheets
      If wsSh.Name Like sSheetName Then
      'Если имя листа совпадает с именем листа, в который собираем данные
      'и сбор идет только с активной книги - то переходим к следующему листу
      If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
      With wsSh
      Select Case iBeginRange.Count
      Case 1 'собираем данные начиная с указанной ячейки и до конца данных
      lLastRow = .Cells(1, 1).SpecialCells(xlLastCell).Row
      iLastColumn = .Cells.SpecialCells(xlLastCell).Column
      sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastRow, iLastColumn)).Address
      Case Else 'собираем данные с фиксированного диапазона
      sCopyAddress = iBeginRange.Address
      End Select
      'должен был каждый раз удалять старые значения и копировать по новой но не работает
      lLastRowMyBook = wsDataSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

      'удаляем мия файла книг оставляя только первое занчение
      AWN = ActiveWorkbook.Name
      AWN = Mid(AWN, 1, 1)

      'вставляем имя книги, с которой собраны данные
      If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = AWN
      If bPasteValues Then 'если вставляем только значения
      .Range(sCopyAddress).Copy
      wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues
      Else
      .Range(sCopyAddress).Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
      End If
      End With
      End If
      NEXT_:
      Next wsSh
      If bPolyBooks Then Application.CutCopyMode = False: wbAct.Close False 'не будет запроса от буфера обмена на большое количество данных в нем
      Next li
      With Application
      .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
      End With

      'Удаление строк
      Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
      Dim lMet As Long
      Dim arr
      sSubStr = "" 'искомое выражение в ячейке которое нужно удалить
      lCol = 12 'столбец в котором нужно искать значение(в книге куда были скопированы данные)

      lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
      arr = Cells(1, lCol).Resize(lLastRow).Value
      Application.ScreenUpdating = 0
      Dim rr As Range
      For li = 1 To lLastRow
      If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then
      If rr Is Nothing Then
      Set rr = Cells(li, 1)
      Else
      Set rr = Union(rr, Cells(li, 1))
      End If
      End If
      Next li
      If Not rr Is Nothing Then rr.EntireRow.Delete
      Application.ScreenUpdating = 1

      End Sub

      Вопросы на засыпку: все таки не происходит замены старых данных на новые при повторе макроса(сначала был потом пропал-мистика); как сделать запрос "Выберите направление 0,1,2,3" и чтобы введенное значение изменяло в программе имя листа на который будут скопированы данные.

      • Роман, почитайте комментарии. Чтобы сбор данных происходил с заменой надо как минимум лист для сбора очищать от прежних данных. У Вас этого нет. Сделайте что-то вроде:

        вставить это надо вместо этого:

        • Роман:

          Рабочий вариант:

          а на счет кнопки есть мысли? В каком направлении хотя бы смотреть...

  5. Мария Дорофеева:

    Дмитрий, огромное Вам спасибо за макрос и за все ваши статьи и материалы! Очень полезно в работе. С помощью данного макроса сократила время выполнения своей задачи с 8 часов до получаса.

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code class="" title="" data-url=""> <del datetime=""> <em> <i> <q cite=""> <strike> <strong> <pre class="" title="" data-url=""> <span class="" title="" data-url="">

Логин
Наши партнеры
Перейти
Перейти
Счетчики
Анализ сайта

Яндекс.Метрика
© 2017 Excel для всех  Войти