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

[BUSHMANOV]

Первого числа каждого месяца разные люди присылают отчётные таблицы (пример файлы Excel под названием 1, 2, 3 – это три разных человека).

Мне необходимо просто сделать сводную таблицу Excel (пример файл Excel под названием Сводная таблица - это, что должно получиться).

На сегодняшний день тупо открываю файл 1, выделяю, копирую, вставляю в файл Сводная таблица. Открываю файл 2, выделяю, копирую, вставляю в файл Сводная таблица и т.д.

Уверен, что это можно автоматизировать, но в Excel я только на уровне пользователя. Если не сложно подскажите как это сделать. Заранее благодарен.

[EducatedFool]

http://excelvba.ru/code/CombineFiles
во вложении к статье есть файл с макросом, - надо только его немного доработать под ваши файлы

[green worm]

Всем доброго времени суток.
Уже не первая тема где написано как свести из разных файлов данные в одну таблицу.
Пример:
http://www.programmersforum.ru/showthread.php?t=39712
Но задача усложняется тем, что все данные из каждого файла надо сохранить на новый лист с названием = название обработанного файла.

[IgorGO]

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

задача усложняется тем, что все данные из каждого файла надо сохранить на новый лист

вот тут Вы ошибаетесь, это не усложняет задачу, это описывает условия работы программы

[green worm]

Сообщение от IgorGO

вот тут Вы ошибаетесь, это не усложняет задачу, это описывает условия работы программы

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

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

Пока что вот что получилось.

[IgorGO]

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

[green worm]

Прошу прощенья.
Абстрактная задача.
Регулярно поступают отдельные файлы .xls с большими таблицами.
Есть таблица которая обсчитывает данные из них. Для этого вручную создаются новые листы, вручную меняется название на МесяцНазвание файла, все данные из одного из полученных файлов копируются на этот новый лист.
Конкретика.
Из каждого из регионов каждый месяц приходят данные в большой таблице .xls и сохраняются в одну папку. В эту же папку закидывается таблица с уже забитой формулой и начинают создаваться вручную новые листы, на которые копипастятся полностью данные из полученных файлов (полностью - ctrl+a; ctrl+c; ctrl+v). Лист обзывается, к примеру, ЯнварьБашкирия и так далее. Таблица на первой странице проводит подсчет с каждого листа.

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

[green worm]

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

Sub ЗаполнениеСводнойТаблицы()
Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim coll As New Collection, wb As Workbook, sh As Worksheet, newRow As Range
Mask = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "*.xls")

Filename = Dir(Mask)
While Filename <> "" ' перебираем все файлы в текущей папке
If Not Filename Like ThisWorkbook.Name & "*" Then coll.Add Filename
Filename = Dir
Wend

'For Each Item In coll: Debug.Print Item: Next
On Error Resume Next
For Each Item In coll
Set wb = Workbooks.Open(Replace(ThisWorkbook .FullName, ThisWorkbook.Name, Item), , True)
If Not wb Is Nothing Then
Set sh = wb.Worksheets(1)
LastRow = sh.Range("a65000").End(xlUp).Row
If LastRow > 4 Then ' если есть заполненные строки
For i = 5 To LastRow
Set newRow = Me.Range("a65000").End(xlUp).Offset (1)
sh.Rows(i).Copy newRow
newRow.EntireRow.AutoFit
Next i
End If
wb.Close False
End If
Next
Application.DisplayAlerts = True
End Sub



Потом уже сделаю лист на котором будут данные обрабатываться из вновьсозданных листов.

[green worm]

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

Dim newlis As Worksheet
Set newlis = ActiveWorkbook.WORKSHEETS.Add
newlis.Name = Filename

[Aleksandr H.]

А ТС и "green worm" ето один и тот же человек или разные? В первом сообщении одни файлы а в 5 вообще другие

по размещению.
Dim в своем разделе
set перед Set sh = wb.Worksheets(1)
тогда и строку Set sh = wb.Worksheets(1) надо изменить в выделеном месте
newlis.Name = Filename после set newlis, но тоже б надобно сменить выделеную часть.
IMHO