Этот макрос предназначен для сбора (загрузки) информации из файлов Excel, расположенных в одной папке.
Для работы этого макроса, помимо него самого, вам понадобится добавить в свой файл:
- функцию FilenamesCollection для получения списка файлов в папке
- функцию GetFolder для вывода диалогового окна выбора папки с запоминанием выбранной папки
- прогресс-бар для отображения процесса обработки файлов (модуль класса и форму)
Если при тестировании макроса у вас возникает ошибка, что не найдена та или иная функция,
— проверьте, все ли необходимые компоненты (которые перечислены выше) вы добавили в свой файл.
Этот макрос я публикую прежде всего для себя (поскольку использую этот код чуть ли ни в каждой третьей своей программе),
поэтому я не буду помогать вам в настройке этого макроса, если у вас он вдруг не заработает.
Макрос при запуске выдает диалоговое окно для выбора папки, в которой расположены обрабатываемые файлы,
после чего открывает каждый из файлов, считывает из него данные, помещает их в текущую книгу (из которой запущен макрос),
и закрывает обработанный файл без сохранения изменений.
После того, как очередной файл обработан, он перемещается во вторую папку («архив»).
Код макроса:
Sub ИмпортДанныхИзЗаявок() On Error Resume Next: Err.Clear ' запрашиваем пути к папкам с файлами InvoiceFolder$ = GetFolder(1, , "Выберите папку с файлами заявок (из Outlook)") If InvoiceFolder$ = "" Then MsgBox "Не задана папка с заявками", vbCritical, "Обработка заявок невозможна": Exit Sub ArchieveFolder$ = GetFolder(2, , "Выберите папку, куда будут помещаться обработанные файлы заявок") If ArchieveFolder$ = "" Then MsgBox "Не задана папка для архива заявок", vbCritical, "Обработка заявок невозможна": Exit Sub Dim coll As Collection ' загружаем список файлов по маске имени файла Set coll = FilenamesCollection(InvoiceFolder$, "Заявка №*от*.xls*", 1) If coll.Count = 0 Then MsgBox "Не найдено ни одной заявки для обработки в папке" & vbNewLine & InvoiceFolder$, _ vbExclamation, "Нет необработанных заявок" Exit Sub End If Dim pi As New ProgressIndicator: pi.Show "Обработка заявок", , 2 pi.StartNewAction , , , , , coll.Count ' отображаем прогресс-бар Dim WB As Workbook, sh As Worksheet, ra As Range Application.ScreenUpdating = False ' отключаем обновление экрана (чтобы процесс открытия файлов не был виден) ' перебираем все найденные в папке файлы For Each Filename In coll ' обновляем информацию на прогресс-баре pi.SubAction "Обрабатывается заявка $index из $count", "Файл заявки: " & Dir(Filename), "$time" pi.Log "Файл: " & Dir(Filename) ' открываем очередной файл в режиме «только чтение» Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True) If WB Is Nothing Then ' не удалось открыть файл pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан." Else ' файл успешно открыт Set sh = WB.Worksheets(1) ' будем брать данные с первого листа ' берем диапазон ячеек с ячейки B1 до последней заполненной в столбце B Set ra = sh.Range(sh.Range("b1"), sh.Range("b" & sh.Rows.Count).End(xlUp)) ' ==== переносим данные в наш файл (shb - кодовое имя листа, куда помещаем данные) shb.Range("a" & shb.Rows.Count).End(xlUp).Offset(1).Resize(, ra.Rows.Count).Value = _ Application.WorksheetFunction.Transpose(ra.Value) ' ==== конец обработки данных из очередного файла WB.Close False: DoEvents ' закрываем обработанный файл без сохранения изменений pi.Log vbTab & "Файл успешно обработан." ' перемещаем обработанный файл из папки InvoiceFolder$ в папку ArchieveFolder$ Name Filename As ArchieveFolder$ & Dir(Filename, vbNormal) End If Next ' закрываем прогресс-бар, включаем обновление экрана pi.Hide: DoEvents: Application.ScreenUpdating = True MsgBox "Обработка заявок завершена", vbInformation End Sub
Во вложении - файл со всеми необходимыми макросами для сбора данных из других файлов Excel
Комментарии
Достаточно скачать пример
Как подключить функции для работы макроса или достаточно просто пример скачать?
Антон, код макроса открыт, - можете доработать как вам нужно.
Либо мы можем доработать под заказ (от 1500 руб)
Здравствуйте,последний коммент "как нужно изменить макрос что бы в таблице в столбце в каждой ячейке указывалось бы имя файла из которого эта строка скопирована?"остался без ответа. Он был не мой,но тоже интересен данный вопрос. Возможно допилить макрос?
как нужно изменить макрос что бы в таблице в столбце в каждой ячейке указывалось бы имя файла из которого эта строка скопирована?
Александр, для этого макроса битность Office значения не имеет (всё должно работать)
Здраствуйте, у меня офис 64 бита и программа выдает ошибку.
Как в коде сделать чтоб брал данные с 2 ячеек, а выводил в одну через пробел
Добрый день!
Отличный макрос. Единственный вопрос, не подскажите, каким образом можно дополнить этот макрос, чтобы еще выбирались данные из другой строки/диапазона:
Set ra = sh.Range(sh.Range("b1"), sh.Range("b" & sh.Rows.Count).End(xlUp))
Всё можно
Оформляйте заказ на сайте
https://excelvba.ru/order/send
обязательно прикрепляйте примеры файлов,
и подробно описывайте, что и как должно работать.
Можно ли реализовать возможность обработки word документов из этого же файла?
Я не консультирую по вопросам переделки этого макроса.
Можем сделать макрос под ваши требования под заказ (платно)
Здравствуйте. Подскажите как сделать, чтобы данные из каждого файла записывались в новый столбец (т.е. со сдвигом вправо)?
В файле с макросом то миллион строк, но вот дальше 65000 макрос не вставлял.В общем, проблема была в исходных файлах. Когда они были сохранены как .xlsx, макрос отработал как надо.
П.с. Вообще отличный макрос как заготовка для разных действий с кучей файлов. Спасибо.
Закройте файл после преобразования, и откройте снова
Убедитесь, что в файле миллион строк
Потом только запускайте макрос
У меня 2007 офис. Сохраняю через круглую кнопку сверху, сохранить как, выбираю формат. Ничего не меняется. Макрос перестает работать в районе 65000 строки.
Может такое быть, что это из-за кода?
Файл с макросом надо пересохранить в новом формате.
Меню Excel: Файл — Преобразовать
И на листе будет миллион строк
Потом запускайте сбор данных
в форматах .xlsb и .xlsm всё равно утыкается в 65к строк. Можно что-то ещё сделать?
Алексей, по бесплатным макросам техподдержки нет.
Могу переписать макрос под ваши нужды (платно)
И забыл добавить в диапазоне колонок B, C, D, E, F начиная только со второй строки, т.е. B2 например
Добрый день. Подскажите пожалуйста, а как сделать перебор всех листов файла начиная со второго, первый лист надо исключать.
Игорь большое спасибо
Добрый день!
Пожалуйста подскажите, как сделать, что бы при обрашении запрашивался не первый лист-(Set sh = WB.Worksheets(1)) а определенный с названием Например - Main
Else
Set sh = WB.Worksheets(1)
Set ra = sh.Range(sh.Range("a2"), sh.Range("a" & sh.Rows.Count).End(xlUp)).Resize(, 10)
shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count,ra.Columns.Count).Value = ra.Value
WB.Close False: DoEvents
End If
Спасибо за ответ.
Добрый день!
Подскажите, пожалуйста, а как сделать заполнение книги с определенной строки. Сейчас все данные записываются со строки А2, а нужно к примеру с А3?
Заранее благодарю.
Нет, не получится.
Это диалоговое окно выбора папки (встроенное в Office) - в таких окнах видны только папки и подпапки.
Не видите, какую книгу выбираете, - потому что выбираете вы не книгу, а папку с файлами.
Игорь, можно еще вопрос - при загрузке (выборе) файлов, я невижу какую книгу выбираю, просто пустая папка, можно ли в коде добавить видимость, расширение книг
Аня, код же открыт, - изменяйте его под свои нужды сколько угодно
Если сами не справитесь, - я могу сделать, под заказ (платно)
Попробуйте в этой строке кода
заменить .Value на .Formula (в двух местах)
Но не уверен, что этого достаточно будет (зависит от того, какая формула там, - будет ли она работать при переносе в другой файл без изменений)
Здраствуйте, пользуюсь вашим макросом, у меня такая проблема: при загрузки данных не копируются формулы, можно ли изменить код?
Добрый день! Подскажите пожалуйста, с чего мне лучше начать, мне дали задание сделать отчет по менеджерам, тоесть у каждого менеджера и отделения есть план сколько они должены выдать кредиты по плану по факту и итог по всему отделу, но такая проблема данного менеджера могут перевисти в другое отделение, и по всем excel-м файлом нужно найти данного менеджера в конце месяца посчитать сколько он выдал кредитов...
Сергей, могу написать макрос под заказ.
Оформляйте заказ на сайте, прикрепляйте примеры файлов (несколько исходных, и образей итогового), и подробно описывайте, что и куда должно копироваться.
Добрый вечер.
У мня такая проблема. Каждый месяц получаю заказы от магазинов.
160 строчек позиций и 450 столбцов-магазинов. все это отдельными файлами. Приходится вручную по одному копи-пастить столбцов из 450 файлов в одну таблицу. Все это в EXEL.
Попробовал применить Ваш макрос - не срабатывает. То выдает сообщение о том, что книги защищены, то просто не срабатывает.
Посоветуйте, пожалуйста, как мне решить задачу.
Ваш макрос спас меня перед аудитом, спасибо))
Спасибо - все получилось!!
Добавьте цикл по листам
Вместо этого кода:
напишите
Добрый день. Как добавить в макрос чтобы с загружаемого файла считывались еще и листы под разными именами...
Хотя сейчас вчитался в код, понял, что неправильно написал. Копируется действительно диапазон, а вот вставка идет по значениям.
я решал подобную задачу через Copy-Paste, на другом форуме еще нашел способ копирования через XML
Используем XML структуру листа. (Проверял работу только на 2010)
Dim a As String
a = rng1.Value(XlRangeValueDataType.xlRangeValueXMLSpreadsheet)
rng2.Value(XlRangeValueDataType.xlRangeValueXMLSpreadsheet) = a
В переменную a сохраняется XML описание ячеек с форматами и комментариями.
Единственное ограничение, rng1 и rng2 должны быть одинаковыми по размеру.
Добрый день, Роман!
Данный макрос считывает только значения ячеек
' берем диапазон ячеек с ячейки B1 до последней заполненной в столбце B
Set ra = sh.Range(sh.Range("b1"), sh.Range("b" & sh.Rows.Count).End(xlUp))
соответственно перенести формат в том куске кода, что Вы привели, он никак не может - для этого на предыдущих строках нужно считывать формат.
Если Вам нужен перенос вместе с форматированием, то Вам надо двигаться в сторону Copy-Paste, либо же считывать в другой массив еще и нужные параметры форматирования, а потом воспроизводить форматирование на новом листе.
Если с реализацией у Вас возникнут сложности, можете оформить заказ на сайте.
Добрый день!
Пожалуйста подскажите, как сделать, что бы при переносе информации из файла с которого был перенос данных, макрос сохранял исходное форматирование.
Спасибо за ответ.
' ==== переносим данные в наш файл (shb - кодовое имя листа, куда помещаем данные)
With shb.Range("a" & shb.Rows.Count).End(xlUp).Offset(1).Resize(, ra.Rows.Count)
.Value = Application.WorksheetFunction.Transpose(ra.Value)
.EntireRow.Cells(6) = wb.Name ' имя файла в 6 столбец
End With
' ==== конец обработки данных из очередного файла
Да, можно. Сделайте, код открыт.
Или я могу сделать под заказ.
здавствуйте! а можно как-то сделать, чтобы названия листов тоже переносились?
Сергей, после строки кода
pi.Log vbTab & "Файл успешно обработан."добавьте такую строку:
Ну и заранее добавьте в сводный файл новый лист с названием СПИСОК
Доброго времени суток! Спасибо огромное!
Подскажите как в отдельный лист вытащить список обработанных файлов.
Заранее огромное спасибо!
Спасибо огромное!!!
Игорь классный файл.
Как раз то что надо для сбора данных со всех файлов эксель.
Есть вопрос, как увеличить количество столбцов загрузки.
Т. е. у меня есть много данных по каждому объекту и в сводной таблице нужно отображать много данных по столбцам. Как в коде это исправить.
Заранее спасибо!!!!
Ну а вы сохранили файл с макросом, после того как внесли изменения в код?
Игорь, здравствуйте!
Хотел бы уточнить вопрос.
В макросе сделал лишь одно изменение - вместо 10 столбцов указал 40. Макрос все подтянул и не 1 раз. Стоило закрыть файл и заново попробовать подтянуть, макрос работает, показывает, что все успешно, а в итоге данные не подтягиваются.
С чем это может быть связано?
Сергей, что угодно можно, если макрос переделать немного.
Могу сделать под заказ (платно), - если устраивает такой вариант, пишите в скайп или на почту.
Игорь, добрый день!
Отличный макрос, но я столкнулся с любопытной проблемой, можно ли данные вставлять не как они взяты, а в строчку (у меня один столбец конкретного диапазона в разных книгах)?
Да разобрался. А вот такой вопросик, если в каждой книге по 10 листов и более, а надо брать всего лишь один к примеру в 17 книгах будет одинаковый лист 2017 и надо брать только его, это тоже идет доработка?
Отправить комментарий