Excel VBA Макросы: Новая строка с формулами.

[Посетитель]

Пользуюсь этим макросом для добавления строк с формулами в таблицу. Но макрос добавляет строку, перекрывая записи на нижележащей строке.

Как сделать, чтобы строка вставлялась, т.е. сохранялась строка Итогов и все что находится ниже таблицы?
Кроме того, нужно чтобы обновились формулы в итоговой строке: формулы должны включить новую строку.

Добавляя новые строки после строки 4 с помощью макроса, они "наезжают" на нижележащую таблицу. Возможно ли сделать , чтобы строки добавлялись, а интервал между верхней и нижней таблицей сохранялся?

Макрос

Sub Макрос1()

    Dim lr As Long, lc As Long, j As Long
   
   
    ' Определение последней заполненной строки по столбцу A.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
    ' Определение последнего заполненного столбца по первой строке.
        ' End не ищет в скрытых столбцах.
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
    ' Копируем последнюю строку в строку ниже.
    Rows(lr).Copy Rows(lr + 1)
   
    ' Удаление данных из ячеек, где нет формул.
    For j = 1 To lc Step 1
        If Cells(lr + 1, j).HasFormula = False Then
            Cells(lr + 1, j).ClearContents
        End If
    Next j

End Sub

[свернуть]

[вложение удалено администратором]

[Администратор]

Макрос

Sub Макрос1()

    Dim lr As Long, lc As Long, j As Long
   
   
    ' Выход из режима копирования на случай, если перед запуском макроса какой-то фрагмент скопирован.
        ' Это нужно для команды "Insert".
    Application.CutCopyMode = False
   
    ' Определение последней заполненной строки по столбцу A.
        ' -1 - учитывается итоговая строка.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row - 1
   
    ' Определение последнего заполненного столбца по первой строке.
        ' End не ищет в скрытых столбцах.
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
    ' Копируем последнюю строку в строку ниже.
    '* Вставка пустой строки.
    Rows(lr + 1).Insert
    '* Копирование строки в новую строку.
    Rows(lr).Copy Rows(lr + 1)
   
    ' Корректировка формул в итоговой строке: добавление в формулы новой строки.
    Cells(lr + 2, "B").Resize(, 3).FormulaR1C1 = "=SUM(R[-" & lr & "]C:R[-1]C)"
   
    ' Удаление данных из ячеек, где нет формул.
    For j = 1 To lc Step 1
        If Cells(lr + 1, j).HasFormula = False Then
            Cells(lr + 1, j).ClearContents
        End If
    Next j

End Sub

[свернуть]

[Посетитель]

Большое спасибо за помощь, все супер!!!