MergeSheetsWithImages
Перебирет все листы кроме "Основного", вырежет данные из каждого листа и вставит их в конец "Основного" листа включая изображенияSub MergeSheetsIntoMain() Dim ws As Worksheet Dim mainSheet As Worksheet Dim lastRowMain As Long Dim dataRange As Range ' Установка основного листа Set mainSheet = ThisWorkbook.Worksheets("Основной") ' Перебор всех листов книги For Each ws In ThisWorkbook.Worksheets If ws.Name <> mainSheet.Name Then ' Определение последней строки на основном листе lastRowMain = mainSheet.Cells(mainSheet.Rows.Count, "A").End(xlUp).Row ' Определение диапазона данных на текущем листе With ws Set dataRange = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 19)) ' Предполагается, что данные начинаются со второй строки и идут до 19 столбца End With ' Вырезание и вставка данных dataRange.Cut Destination:=mainSheet.Cells(lastRowMain + 1, 1) End If Next ws End Sub
Leave a Comment