Пользуюсь этим макросом для добавления строк с формулами в таблицу. Но макрос добавляет строку, перекрывая записи на нижележащей строке.
Как сделать, чтобы строка вставлялась, т.е. сохранялась строка Итогов и все что находится ниже таблицы?
Кроме того, нужно чтобы обновились формулы в итоговой строке: формулы должны включить новую строку.
Добавляя новые строки после строки 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