Отличный прием "Сборка данных со всех листов книги в одну таблицу", но мне нужно чтобы ячейки копировались без сохранения исходного формата.
Код
Sub CollectDataFromAllSheets() Dim ws As Worksheet
Set wbCurrent = ActiveWorkbook
Workbooks.Add
Set wbReport = ActiveWorkbook
'копируем на итоговый лист шапку таблицы из первого листа
wbCurrent.Worksheets(1).Range("A1:D1").Copy Destination:=wbReport.Worksheets(1).Range("A1")
'проходим в цикле по всем листам исходного файла
For Each ws In wbCurrent.Worksheets
'определяем номер последней строки на текущем листе и на листе сборки
n = wbReport.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
'задаем исходный диапазон, который надо скопировать с каждого листа - любой вариант на выбор:
Set rngData = ws.Range("A1:D5") 'фиксированный диапазон или
Set rngData = ws.UsedRange 'всё, что есть на листе или
Set rngData = ws.Range("F5").CurrentRegion 'область, начиная от ячейки F5 или
Set rngData = ws.Range("A2", ws.Range("A2").SpecialCells(xlCellTypeLastCell)) 'от А2 и до конца листа
'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
rngData.Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)
Next ws
End Sub
Kuzmich, спасибо за ответ, Это в эту часть вставлять?
Код
'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
rngData.[COLOR=#7b3000][B]Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)
Kuzmich, Ну я лишнее всё убрал, в начальное вставил код из примера с приёма.
Вот мой:
Код
Sub CollectDataFromAllSheets()
Dim ws As Worksheet
Set wbCurrent = ActiveWorkbook
Set wbReport = ActiveWorkbook.Worksheets("DATA")
'копируем на итоговый лист шапку таблицы из первого листа
'wbCurrent.Worksheets(1).Range("A1:D1").Copy Destination:=wbReport.Worksheets(1).Range("A1")
'проходим в цикле по всем листам исходного файла
For Each ws In wbCurrent.Worksheets
'определяем номер последней строки на текущем листе и на листе сборки
n = wbReport.Range("A1").CurrentRegion.Rows.Count
'задаем исходный диапазон и вставляем в итоговую книгу со следующей строки:
Set rngData = ws.Range("A2", ws.Range("A2").SpecialCells(xlCellTypeLastCell)) 'от А2 и до конца листа
'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
rngData.Copy Destination:=wbReport.Cells(n + 1, 1)
Next ws
End Sub
Задачу так и не решил. Пошел другим путем, макросом скинул форматирование на всех листах которые необходимо копировать. Но теперь вопрос, я копирую их на лист в этом же документе, и у меня есть три листа из которых не нужно извлекать информацию, кто подскажет создать новую тему? или кто сможет помочь здесь же? Как исключить первые три листа из копирования?
argyman, так вам как надо: в эту же книгу, новый лист; или новая книга на один лист; или еще как? Все таблицы имеют одинаковую структуру, и данные потом нужно расположить на один лист последовательно?