Копирование таблиц...

[den_irk]

Добрый день.

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

[tae1980]

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

Пример файла во вложении. Как бы этот процесс автоматизировать?

Попробуй это.

[kuklp]

Такой вариант с сохранением формата:

Sub MyPivot()
    Dim sh As Worksheet, n&, tbl As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets("Svod").Delete
    Set sh = Worksheets.Add(, Sheets(Sheets.Count))
    sh.Name = "Svod"
    For n = 1 To Worksheets.Count - 1
    Set tbl = Worksheets(n).[a1].CurrentRegion
        If n = 1 Then
            tbl.Copy sh.[a1]
        Else
                 tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Copy _
                 sh.Cells(sh.[a1].End(xlDown).Row + 1, 1)
        End If
    Next n
    Range(sh.[a2], sh.[a1].End(xlDown)).FormulaR1C1 = "=ROW()-1"
    Application.DisplayAlerts = True
End Sub

Еще вариант, если лист удалять не нужно см. вложение.