MergeSheetsWithImages

Перебирет все листы кроме "Основного", вырежет данные из каждого листа и вставит их в конец "Основного" листа включая изображения
 avatar
user_2065311
vbscript
a month ago
1.1 kB
2
Indexable
Never
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