Очень часто бывает необходимо собрать данные с нескольких листов одной книги или даже с листов нескольких книг. Например, каждую неделю мы получаем некие отчеты от отделов, которые необходимо собрать в одну общую таблицу для построения сводной таблицы. Или это могут быть некие книги прайсов по товарам от разных поставщиком, который опять же надо сначала объединить, а потом уже анализировать. Вручную делать это довольно муторно. И то, муторно это только для первых 20-ти листов/файлов, потом становится просто тошно. Поэтому решил поделиться решением, которое поможет собрать данные со всех листов книги, со всех листов всех указанных книг или только с указанных листов:
'--------------------------------------------------------------------------------------- ' Author : Щербаков Дмитрий(The_Prist) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' https://www.excel-vba.ru ' info@excel-vba.ru ' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872 ' 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 Range, rCopy As Range, 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 Worksheet, wsDataSheet As Worksheet, bPolyBooks As Boolean, avFiles Dim wbAct As Workbook Dim bPasteValues As Boolean, IsPasteSheetName As Boolean On Error Resume Next 'Выбираем диапазон выборки с книг Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _ "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _ vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8) 'для указания диапазона без диалогового окна: 'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный 'Если диапазон не выбран - завершаем процедуру If iBeginRange Is Nothing Then Exit Sub End If 'Указываем имя листа 'Допустимо указывать в имени листа символы подставки ? и *. 'Если указать только * то данные будут собираться со всех листов sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр") 'Если имя листа не указано - данные будут собраны со вех листов If sSheetName = "" Then sSheetName = "*" End If 'добавлять ли имя листа в начало таблицы IsPasteSheetName = (MsgBox("Вставлять имя листа первым столбцом?", vbQuestion + vbYesNo, "www.wxcel-vba.ru") = vbYes) On Error GoTo 0 'Запрос - вставлять на результирующий лист все данные 'или только значения ячеек (без формул и форматов) bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "www.wxcel-vba.ru") = vbYes) 'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги) If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "www.wxcel-vba.ru") = vbYes Then avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True) If VarType(avFiles) = vbBoolean Then Exit Sub bPolyBooks = True lCol = 1 Else avFiles = Array(ThisWorkbook.FullName) End If If IsPasteSheetName Then lCol = lCol + 1 End If 'отключаем обновление экрана, автопересчет формул и отслеживание событий 'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды With Application lCalc = .Calculation .ScreenUpdating = False .EnableEvents = False .Calculation = xlManual End With 'создаем новый лист в книге для сбора Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)) 'если нужно сделать сбор данных на новый лист книги с кодом 'Set wsDataSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'цикл по книгам For li = LBound(avFiles) To UBound(avFiles) If bPolyBooks Then Set wbAct = Workbooks.Open(Filename:=avFiles(li)) 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.SpecialCells(xlLastCell).Row + 1 'определяем для копирования диапазон только заполненных данных на листе Set rCopy = Intersect(.Range(sCopyAddress).Parent.UsedRange, .Range(sCopyAddress)) 'вставляем имя книги, с которой собраны данные If lCol > 0 Then If bPolyBooks Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(rCopy.Rows.Count).Value = oAwb End If If IsPasteSheetName Then wsDataSheet.Cells(lLastRowMyBook, lCol).Resize(rCopy.Rows.Count).Value = .Name End If End If 'если вставляем только значения If bPasteValues Then rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteFormats Else 'если вставляем все данные ячеек(формулы, форматы и т.д.) rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol) End If End With End If NEXT_: Next wsSh If bPolyBooks Then wbAct.Close False End If Next li With Application .ScreenUpdating = True .EnableEvents = True .Calculation = lCalc End With End Sub |
Приведенный выше код необходимо вставить в стандартный модуль(Что такое модуль? Какие бывают модули?). Выполнить его можно будет из этой книги нажатием клавиш Alt+F8. В появившемся окне выбрать
После вызова макроса поочередно будут появляется запросы, в которых надо будет указать исходные параметры:
Диапазон сбора данных - Если в окне выбора диапазона выбрать только одну ячейку, то данные будут собраны со всех листов книги/книг, начиная с этой ячейки и до последней ячейки листа.
Если выбрать несколько ячеек, данные будут собраны только с указанного диапазона всех листов книги/книг. Допускается указать несвязанный(рваный) диапазон(например, только три столбца: ). Сделать это можно, выделив нужный диапазон с зажатой клавишейA:A ,D:D ,F:F Ctrl . Здесь необходимо учитывать, что Excel позволяет одним махом скопировать не любые рваные диапазоны, а только диапазоны одного размера и только если они начинаются с одной строки. Например, если выделить диапазоны - они будут скопированы без проблем. Но если попробовать указать диапазоны со сдвигом:A1:B20 ,F1:H20 - Excel выдаст ошибку.A1:B20 ,F2:H21 Имя листа - Необязателен для указания. Если не указан - данные будут собраны со всех листов. Указать можно как точное соответствие имени листа, так и с частичным соответствием. Например, если в книгах для сбора данных необходимо собрать данные только с листа "Январь", то следует так и указать - "Январь". Если требуется собрать данные только с листов, начинающихся с "Продажи"("Продажи ЮГ", "Продажи НН", "Продажи Запад" и т.д.), то следует применить символ подстановки звездочку - "Продажи*". Если надо собрать с листов, содержащих в имени "продажи"("Итоговые продажи ЮГ", "Продажи НН", "Сезонные продажи" и т.д.), то указываем "*продажи*". Если надо собрать только с листа "Сезонные продажи", но известно, что вместо пробела может быть нижнее подчеркивание или тире("Сезонные продажи", "Сезонные_продажи", "Сезонные-продажи") или иной символ, то можно также применить звездочку - "Сезонные*продажи". Но если среди листов могут встречаться и такие как "Сезонные разовые продажи", "Сезонные корпоративные продажи" и т.п., но информацию с них собирать не надо, то можно применить вопросительный знак - "Сезонные?продажи". Вопросительный знак заменяет любой один символ, звездочка - любое количество любых символов.Вставлять имя листа первым столбцом? - если выбрать Да, перед данными в итоговой таблице будут записаны имена листов, с которых были собраны данные. Если будет указано собирать данные с нескольких книг - то имя листа будет во втором столбце, если с листов одной книги - то имя листа будет первым столбцом.Вставлять только значения? - если выбрать Да, то в результирующий лист с листов будут вставлены исключительно значения ячеек (без формул), но при этом сохранятся их форматы(формат чисел, цвет заливки, цвет шрифта, границы и т.п.). Может пригодится, если на листах для сбора записаны формулы, ссылающиеся на другие листы, книги, диапазоны. При обычном копировании может случиться так, что формула выдаст ошибку, т.к. в книге для вставки нет таких листов и диапазонов или данные расположены иначе. Если выбрать Нет, то все ячейки с листов на результирующий будут копироваться в точности как в исходных листах.- И последний запрос:
Собрать данные с нескольких книг? - если выбрать Да, то появится диалоговое окно выбора файлов. Надо указать все файлы, данные с которых необходимо собрать. Если выбрать Нет, то данные будут собираться с листов только активной книги. При этом, если выбран вариант сбора с нескольких книг, то первым столбцом в итоговой таблице будут записаны имена файлов, с которых были собраны данные
Данные будут собраны на новый лист книги с макросом. Если данные собирались с нескольких книг, то в первый столбец будут занесены имена книг, с которых собраны данные.
Если после сбора данных обнаружили, что после каждого файла/листа много пустых строк, то следует найти в коде строку:
lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row |
и заменить её на строку примерно следующего содержания:
lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row |
Актуально это для файлов с одинаковой структурой. Например, если сбор идет с листов по продажам, то вполне может быть такое, что в столбце 1 может не быть данных. Поэтому следует определить номер столбца, в котором наполнение данных максимально. Например, это может быть столбец с наименованиями товара или с суммами. Если это столбец D, то следует строку записать так:
lLastrow = .Cells(.Rows.Count, 4).End(xlUp).Row 'ищем последнюю строку в 4-м столбце |
Важное замечание: Если вы используете Excel 2007 и выше и файлы для сбора данных тоже в этом формате, то следует скачанный файл сначала сохранить в формат "Книга Excel с поддержкой макросов(.xlsm)", закрыть и открыть заново. Иначе есть шанс получить ошибку при сборе данных, т.к. Excel будет в режиме совместимости и не сможет поместить на результирующий лист более 65536 строк.
Сбор данных с листов и книг.xls (73,0 КиБ, 38 206 скачиваний)
Также см.:
Сбор данных с нескольких листов/книг
Как объединить несколько текстовых файлов в один?
Просмотреть все файлы в папке
План-фактный анализ в Excel при помощи Power Query
Дмитрий, день добрый.
Прочитала комментарии, потыкалась, не выходит, только начала осваивать VBA.
Подскажите, пожалуйста, если найдется время, как добавить, чтобы помимо наименования файла из определенной ячейки брались данные и заносились в столбец?
Как сделать это вместо названия файла я поняла, а вот как сделать, чтобы было и то, и другое.. что-то пока нет.
Глубокоуважаемый автор сего восхитительного макроса!
А ответьте пожалуйста малосведущему в VBA пользователю на такой каверзный вопрос.
Можно ли(сложно ли) прикрутить к этому алгоритму сбора данных еще и функцию выборки определенных данных(а не последовательного простого копирования указанных диапазонов)?
Поясню что я имею.... в виду.
Имеется книга с набором листов Графиков работы подразделений.
Наименования листов стандартизированы макросом, создающим эти графики из образцового листа(формат Номер месяца-Год_Аббревиатура наименования подразделения).
В графике каждой персоне отведен массив данных из 2 строк(одна строка - рабочие часы, и вторая - ночные рабочие часы) и 31 колонка(дни месяца).
Имеется лист "Табель рабочего времени", в который, по замыслу, должны собраться данные из графиков нужного месяца, года и имени подразделения(или всех подразделений) в соотвествии с выставленными в определенных ячейках условиями выборки.
На листе табеля имеется список имен всех работников всех подразделений.
По замыслу, хотелось бы макросом (формулами я уже второй месяц безуспешно пытался это решить) по списку имен в Табеле (список может корректироваться по принципу выборки определенного подразделения, или определенных лиц(к примеру уходящих в отпуск или увольняющихся)) и выставленных в определенных ячейках месяце, годе и наименованию подразделения, сделать выборку данных с листов графиков работы.
Ну как-то так, немного сумбурно, но все-таки...
зы Прошу, если это возможно, пояснить реализацию алгоритма выборки по условиям, ибо алгоритм копирования собранного табеля на лист отчета, с переименованием его в определенном формате, у меня уже есть.
Как я сам себе придумал надо:
- опросить последовательно ячейки с именами в Табеле
- на основании полученного имени, - просмотреть листы с названиями отвечающими условиям выборки и найти там необходимый для копирования диапазон ячеек с данными,
- скопировать этот диапазон (а лучше создать связь с данными этого диапазона) в соотвествующий этому имени диапазон ячеек в Табеле,
- пройти по всем именам в шаблоне табеля и в конце предложить сохранить табель на новый лист(или, может лучше, лист табеля создавать из шаблона сначала, и в процессе работы макроса заполнить его выбранными данными из графиков).
извиняюсьзаоченьмногобукв!!!
зы зы Если, вдруг, кому-то станет интересно покопаться в этом... Ну и на всякий случай ...https://dropmefiles.com/zMKcv .
приложил файлик примера,
но не разобрался как это можно тут сделать иначе чем
При сборе книг выбивает в ошибку, ссылаясь на строку в тексте макроса
Set wbAct = Workbooks.Open(Filename:=avFiles(li))
Антон, можете привести текст и номер ошибки? По сути варианта 2:
Application.Workbooks.Open(Filename:=avFiles(li))
1. Какой-то сбой. Иногда помогает добавление явной ссылки на приложение:
2. Файлы расположены в папке, к которой не проставлено доверие и файлы открываются в защищенном режиме. Тогда тоже будет возникать ошибка, т.к. книга по сути недоступна для получения из неё данных.
Добрый день.
Дмитрий, если в собираемых книгах последняя ячейка объединенная, то макрос берёт не все столбцы. То есть, если в таблице, которая находится в диапазоне A1:G40, последняя ячейка - D40:G40 (объединенная), то макрос берёт только столбцы с A по D, не взяв столбцы с E, F и G. Потому что, в этом примере, ActiveSheet.Cells(1, 1).SpecialCells(xlLastCell).Column возвращает 4 (то есть столбец D), хотя есть данные и в столбцах E, F и G. Причина - последняя ячейка этого листа - объединенная (D40:G40).
Перед строкой:
lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
я написал:
.Cells(1, 1).SpecialCells(xlLastCell).MergeCells=False
Вроде работает.
Очень странно, что SpecialCells(xlLastCell).Column возвращает 4, а не 7, как должно бы по спецификации быть. Пример бы такого файла глянуть. Да и ActiveSheet меня в этой записи смущает и Cells(1, 1). У меня в коде Cells(1, 1) для Column не применяется, не говоря уже про ActiveSheet. У меня все обращения идут к конкретным листам, а не к активному.
А MergeCells=False - плохая практика, т.к. Вы снимаете объединение с ячейки исходных данных, которое возможно, нужно.
Дмитрий, добрый день! Пытаюсь изучить ваш супер макрос) Подскажите следующие моменты пожалуйста:
1. If VarType(avFiles) = vbBoolean Then Exit Sub - здесь не понимаю в каком случае avFiles может быть Boolean, ведь мы выбираем файлы в переменную avFiles, а это же String?
2. If bPolyBooks Then - а здесь не пойму как работает синтаксис - если bPolyBooks - что? Т.е обычно же надо писать ЕСЛИ переменная = тому-то ТО ...
Заранее спасибо за ответы!
Annie91Диалоговое окно выбора файлов/папки
1. "в каком случае avFiles может быть Boolean" - если мы нажали кнопку Отмена вместо выбора файлов. Вот здесь описано чуть более подробно:
2. "если bPolyBooks - что?". По умолчанию, если у нас одно условие, то bPolyBooks будет сравниваться с True. Это если кратко, хотя история там чуть длиннее :)
спасибо за оперативный ответ! Почитаю обязательно!
Это гениально
Здравствуйте, Дмитрий. Спасибо Вам за очень ценный скрипт. Всё вроде класс, но есть проблема: в создаваемом макросом массиве данных появляются неверные значения. У меня 8 исходных файлов: по одному файлу на каждый месяц 2020го года. В каждом количество листов соответствует количеству дней в соответствующем месяце. В создаваемом массиве в строках соответствующих 30му листу источника информации вместо нужных данных появляются другие значения. Я не могу их найти в исходнике. Зато в строках, которые должны соответствовать 31му листу значения соответствуют 30му листу.
Виктор, чудес не бывает. Вполне вероятно, что у Вас в книге просто есть скрытый лист:Как сделать лист скрытым? или очень скрытый: Как сделать лист очень скрытым
Дмитрий, спасибо Вам большое за макрос!
Скажите, пожалуйста, при выборе нескольких книг (файлов *xls) выдает следующее окно:
В буфере обмена находится большой объем данных. Сохранить эти данные для последующей вставки в другую программу? * Чтобы сохранить данные нажмите кнопку "ДА"
Можно ли обойти эту процедуру ?
Сбор данных начинаю всегда с ячейки A1.
Заранее Спасибо!
Добавьте перед строкой:
такую:
Application.CutCopyMode = False
Добрый! При попытке простой сборки с двух листов ошибка на последнем шаге при отказе от сбора из других книг Object variable or With block variable not set
cсылается на
rCopy.Copy
Сергей, проблему надо искать в данных. Возможно, в одном из листов просто их просто нет(пустой лист или нет данных в указанном для сбора диапазоне).
Дмитрий! Огромное спасибо за код! Даже то, что я его нашел уже облегчает работу на 50%. Разрешите вопрос: позволяет ли данный макрос при анализе абсолютно одинаковых таблиц на всех листах просуммировать данные ячеек? Или Ваш макрос чисто для объединения на 1 листе всех данных с других листов и книг? В моем случае у меня есть торговые объекты, по каждому объекту расход ТМЦ, например, кофе. Вот в сводной таблице хотелось бы объединить в одну ячейку весь расход по объектам. Решаемо?
Евгений, решаемо. Но не этим кодом. Можно собрать данные, а потом на основе итоговой таблицы сделать сводную. Либо использовать Power Query:Собрать и просуммировать данные из разных файлов при помощи PowerQuery Сбор данных с нескольких листов/книг . Но она только месяц бесплатная, а потом увы...
Или скачать мою надстройку(там сбор данных умеет агрегировать(сумма, кол-во и т.п.)):
Пробовал Power Query. Но он тоже почему данные двух совершенно одинаковых таблиц сваливает друг за другом сверху вниз. Не пойму что не так делаю. Есть размышления?
Евгений, на какой ответ рассчитываете, если у меня в видео все получается, а у Вас нет?форум - PowerQuery, PowerPivot, PowerBI и запросы - создайте там тему, опишите свои действия и проблему, приложите файл запроса при необходимости.
Очевидно, где-то что-то забываете(группировать, например). А может еще что не так делаете. Откуда мне что-то знать, если Вы не дали никакой информации по своим действиям? :) Обратитесь в
Здравствуйте. Попытался на форуме оставить сообщение. Зарегистрировался, но активация не происходит. А при попытке войти выходит сообщение "Извините, данная учетная запись не одобрена Администратором. Если Вам необходимо повторно отправить письмо с кодом активации, пожалуйста, нажмите здесь." Жму "здесь" и мне снова отправляет письмо, но на электронку ничего не приходит! В СПАМЕ пусто!!! второй день уже проверяю. Помогите, пожалуйста.
Евгений, активировал Вашу запись вручную