Объединения нескольких файлов - Microsoft Office Excel

lioon · 31.10.2013, 11:55

Добрый день,

Столкнулся с вопросом объединения нескольких файлов xls в одну таблицу.
Если все файлы лежат в одной папке - проблем нет, но как быть если есть папка со множеством подпапок, в которых содержится одинаковый файл "Список чертежей.xls" с разным содержанием.

Можно конечно осуществить поиск всех файлов по имени, скопировать их в одну папку, переименовать и объединить, но это очень прямолинейно. (

EducatedFool · 31.10.2013, 12:10

Готовое решение:
http://excelvba.ru/code/CombineFiles
(только удалить немного лишнего надо из кода)

и внести небольшие изменения:

Код:

 ' загружаем список файлов по маске имени файла
   Set coll = FilenamesCollection(InvoiceFolder$, "Список чертежей.xls", 100)

lioon · 31.10.2013, 12:54

Спасибо! То что нужно! ))))))))

lioon · 01.11.2013, 05:07

Код отличный, только почему то гиперссылки не копируются (

EducatedFool · 01.11.2013, 06:03

потому что код не копирует ячейки, а переносит ЗНАЧЕНИЯ ячеек
(это заметно ускоряет процесс переноса данных)

Используйте метод COPY - и всё будет переноситься:
ДиапазонИзФайла.Copy ПерваяПустаяЯчейкаДляВставкиВСводно мФайле

lioon · 01.11.2013, 07:22

Спасибо! Получилось, но есть проблема после отработки макроса съедает шапку в таблице (я так понимаю последнюю строку):

Попробовал добавить +1 строку, но не срабатывает

Set ra = sh.Range(sh.Range("A3"), sh.Range("D" & sh.Rows.Count).End(xlUp)).Copy

shd.Range("a" & shd.Rows.Count + 1).End(xlUp).Insert

lioon · 01.11.2013, 07:27

Сори я сам сглупил Offset(1) удалил.

Set ra = sh.Range(sh.Range("A3"), sh.Range("D" & sh.Rows.Count).End(xlUp)).Copy
shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1) .Insert

Такой код делает всё как мне нужно. Спасибо

31.10.2013, 11:55	#1
lioon Пользователь Регистрация: 06.05.2011 Сообщений: 38	Объединения нескольких файлов Добрый день, Столкнулся с вопросом объединения нескольких файлов xls в одну таблицу. Если все файлы лежат в одной папке - проблем нет, но как быть если есть папка со множеством подпапок, в которых содержится одинаковый файл "Список чертежей.xls" с разным содержанием. Можно конечно осуществить поиск всех файлов по имени, скопировать их в одну папку, переименовать и объединить, но это очень прямолинейно. (

31.10.2013, 12:10	#2
EducatedFool Программист VBA СуперМодератор Регистрация: 13.07.2008 Сообщений: 6,856	Готовое решение: http://excelvba.ru/code/CombineFiles (только удалить немного лишнего надо из кода) и внести небольшие изменения: Код: `' загружаем список файлов по маске имени файла Set coll = FilenamesCollection(InvoiceFolder$, "Список чертежей.xls", 100)` __Полезные надстройки для Excel. Парсинг сайтов и файлов. Макросы любой сложности на заказ. Мониторинг цен конкурентов

01.11.2013, 06:03	#5
EducatedFool Программист VBA СуперМодератор Регистрация: 13.07.2008 Сообщений: 6,856	потому что код не копирует ячейки, а переносит ЗНАЧЕНИЯ ячеек (это заметно ускоряет процесс переноса данных) Используйте метод COPY - и всё будет переноситься: ДиапазонИзФайла.Copy ПерваяПустаяЯчейкаДляВставкиВСводно мФайле __Полезные надстройки для Excel. Парсинг сайтов и файлов. Макросы любой сложности на заказ. Мониторинг цен конкурентов

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
макрос для объединения информации из нескольких файлов	xenus91	Microsoft Office Excel	2	13.08.2013 12:28
Открытие нескольких файлов	BuT@JL	Общие вопросы Delphi	3	13.03.2011 00:05
Открытие нескольких файлов	ChEaTeR-abc	Помощь студентам	6	15.07.2010 17:03
Сводная таблица путем объединения нескольких диапазонов	ЛесяЛ	Microsoft Office Excel	1	10.01.2010 22:54

31.10.2013, 12:54	#3
lioon Пользователь Регистрация: 06.05.2011 Сообщений: 38	Спасибо! То что нужно! ))))))))

01.11.2013, 05:07	#4
lioon Пользователь Регистрация: 06.05.2011 Сообщений: 38	Код отличный, только почему то гиперссылки не копируются (

01.11.2013, 07:22	#6
lioon Пользователь Регистрация: 06.05.2011 Сообщений: 38	Спасибо! Получилось, но есть проблема после отработки макроса съедает шапку в таблице (я так понимаю последнюю строку): Попробовал добавить +1 строку, но не срабатывает Set ra = sh.Range(sh.Range("A3"), sh.Range("D" & sh.Rows.Count).End(xlUp)).Copy shd.Range("a" & shd.Rows.Count + 1).End(xlUp).Insert

01.11.2013, 07:27	#7
lioon Пользователь Регистрация: 06.05.2011 Сообщений: 38	Сори я сам сглупил Offset(1) удалил. Set ra = sh.Range(sh.Range("A3"), sh.Range("D" & sh.Rows.Count).End(xlUp)).Copy shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1) .Insert Такой код делает всё как мне нужно. Спасибо