Объединение файлов одинаковой структуры в один файл

[Tankiss]

Добрый вечер!

Подскажите, пожалуйста!

Имеется несколько файлов *.xls абсолютно одинаковой структуры.

Можно ли объединить их в один большой)))?

Заранее благодарю за ответы и советы.





--------- примечание модератора - вдруг кому пригодится --------------

На сайте ExcelVBA.ru можно скачать универсальную программу обработки прайс-листов:
http://excelvba.ru/programmes/Unification
которая может объединять не только одинаковые, но разные по структуре файлы Excel.

Программа «Прайс лист», выполненная в виде надстройки для Excel, позволяет вам нажатием одной кнопки преобразовать множество прайс-листов различных форматов к единому виду.

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

Возможностей в программе множество — например, она умеет делать наценку (в т.ч. и «сложную»), конвертировать цены из одной валюты в другую, выполнять замены наименований, выделять нужные данные (характеристики) из описания товара при помощи специальных функций.

Создавать итоговый прайс можно в формате Excel (по шаблону XLS) или в CSV (разделители столбцов, кодировка, и всё такое - настраивается)

Вы легко сможете настроить программу обработки прайс-листов под свои нужды.
Если сами не разберётесь — позвоните в Скайп (ник: ExcelVBA.ru), — получите бесплатную консультацию, с демонстрацией возможностей программы.

Программа изначально предназначалась для обработки прайс-листов на автозапчасти, но подойдёт для абсолютно любых файлов Excel.
Для обработки прайс-листов на автомобильные шины и диски, в программу добавлены специальные функции.

Обновления к программе «Прайс-лист» выходят регулярно, — соответственно, в программу постоянно добавляются новые возможности.

[The_Prist]

Макрос собирает данные со всех листов выбранных книг. Либо только указанный диапазон, либо начиная с указанной ячейки.

[Tankiss]

Огромное спасибо!!! То что мне надо!!

[kzld]

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

Макрос собирает данные со всех листов выбранных книг. Либо только указанный диапазон, либо начиная с указанной ячейки.

Хочется чуть большей фунциональности.
Выбор не только книг (файлов) но и выбор листов в книге.
И ещё заметил :
Почему то "сьедает" последнюю строку из листа откуда берёт данные

[The_Prist]

Исправил "съедание" последней строки и добавил возможность указания листов для сбора. При указании имени листа допускается использование символов подстановки(?*).

[yakimsl]

Подскажите а возможно к этому еще добавить, чтобы выдавал названия листа по строке в файле "СборДанных".
Например: у меня есть книга в которой 34 листа-это названия предприятий, когда я выбираю диапазон в файле "СборДанных" я получаю ОДНУ таблицу но для дальнейшей работы с ней мне нужно знать какое это пр-тие (тоесть название листа)

[kzld]

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

Имеется несколько файлов *.xls абсолютно одинаковой структуры.

а вот у меня в файле 3 листа одинаковые по структуре , а три других отличаются. Потому задача стоит собрать данные только с этих 3-х листов, не затрагивая остальные. Как это можно осуществить?

[kzld]

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

Исправил "съедание" последней строки и добавил возможность указания листов для сбора. При указании имени листа допускается использование символов подстановки(?*).

Было бы здорово, если бы присутствовала кнопка "ОБЗОР" , а то не всегда на память можно внести названия листов , с которых надо брать данные

[Vyaseleva]

Можно ли объединить таблицы из разных книг с данными только на одном листе в одну отдельную таблицу, но с одной шапкой.Таблицы (структура) идентичны данные разные (на разные месяцы) в прикрепленных данных все показано: первоначальные данные и как должно выглядить после объединения

[Kudrjshev]

Имеем
\\Sbs\Август 2010
В папке «август 2010» есть еще 31 папка
Требуется при запуске макроса найти все файлы Excel
в папке Август 2010 включая вложенные папки и скопировать все данные из этих книг
в указанную книгу с:\test.xls и лист 2. имя будет постоянным
есть макрос - только файлы нужно выделять вручную а хотелось бы чтоб он находил сам все файлы в указанной директории
и изменить запрос листа и ячеек на постоянное значение
макрос нашел в Инете у самого ума не хватает помогите если можете, пожалуйста!


Option Explicit

Sub Consolidated_Range_of_Books_and_She ets()
Dim iPivotRange As Range, iDestinationRange As Range, iBeginRange As Range, Sheet
Dim iRngAddress As String, oAwb As String, DataSheet As String, _
iCopyAddress As String, sSheetName As String, oFile
Dim lLastrow As Long, lLastRowMyBook As Long
Dim iLastColumn As Integer
Dim Str() As String

ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
DataSheet = ThisWorkbook.ActiveSheet.Name
On Error Resume Next
Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
"1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
If iBeginRange Is Nothing Then Exit Sub
sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
If sSheetName = "" Then sSheetName = "*"
On Error GoTo 0
With Application.FileDialog(msoFileDialo gFilePicker)
.AllowMultiSelect = True
.InitialFileName = "*.*"
.Title = "Выберите файлы"
If .Show = False Then Exit Sub
For Each oFile In .SelectedItems
Workbooks.OpenText Filename:=oFile
oAwb = Dir(oFile, vbDirectory)

Application.ScreenUpdating = False
Workbooks(oAwb).Activate
For Each Sheet In Sheets
If Sheet.Name Like sSheetName Then
Sheet.Activate
Select Case iBeginRange.Count
Case 1
lLastrow = Cells(1, 1).SpecialCells(xlLastCell).Row
iLastColumn = Cells.SpecialCells(xlLastCell).Colu mn
iCopyAddress = Range(Cells(iBeginRange.Row, iBeginRange.Column), Cells(lLastrow, iLastColumn)).Address
Case Else
iCopyAddress = iBeginRange.Address
lLastrow = iBeginRange.Rows.Count
iLastColumn = iBeginRange.Columns.Count
End Select
lLastRowMyBook = ThisWorkbook.Sheets(DataSheet).Cell s.SpecialCells(xlLastCell).Row + 1
iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(Da taSheet).Range(iRngAddress)
End If
Next Sheet
Workbooks(oAwb).Close False
Next oFile
End With
Application.ScreenUpdating = True
End Sub