Формула VBA для добавления новой строки с формулой - PullRequest
Новая
       13

Формула VBA для добавления новой строки с формулой

0 голосов
/ 05 марта 2019

Может кто-нибудь помочь мне настроить этот код, чтобы исправить мое решение?

У меня есть кнопка, которая добавляет х количество новых строк от A5 и ниже.Столбцы A - Z.

Я бы хотел, чтобы новые строки были пустыми, но все же содержали выпадающие списки и формулы.Новичок в VBA и борется с этим.

Я думаю, что мне нужно изменить диапазон и добавить xlPasteFormulas, но не уверен, где и как для обоих.Любая помощь очень ценится. 

Option Explicit

Sub AddRows()

    Dim x As Integer

    x = InputBox("How many rows would you like to add?", "Insert Rows")

    'Selecting range to insert new cells
    Range(Cells(5, 1), Cells(x + 4, 1)).EntireRow.Insert

    'Copys current cell A6 and past in the new cells
    Cells(x + 5, 1).Copy Range(Cells(5, 1), Cells(x + 4, 1))

    'if you want the cells to be blank but still have the drop down options
    Range(Cells(5, 1), Cells(x + 4, 1)).ClearContents

End Sub

1 Ответ

0 голосов
/ 05 марта 2019

Пожалуйста, попробуйте код ниже.Он скопирует все из BaseRow, а затем удалит постоянные значения в этом диапазоне, оставив форматы, включая проверки данных и формулы. 

Sub AddRows()

    Const BaseRow As Long = 11   ' modify to suit

    Dim x As String             ' InputBox returns text if 'Type' isn't specified
    Dim Rng As Range
    Dim R As Long

    x = InputBox("How many rows would you like to add?", "Insert Rows")
    If x = "" Then Exit Sub
    R = BaseRow + CInt(x) - 1

    Rows(BaseRow).Copy          'Copy BaseRow
    'specify range to insert new cells
    Set Rng = Range(Cells(BaseRow, 1), Cells(R, 1))
    Rng.Insert Shift:=xlDown

    ' insert the new rows BEFORE BaseRow
    ' to insert below BaseRow use Rng.Offset(BaseRow - R)
    Set Rng = Rng.Offset(BaseRow - R - 1).Resize(Rng.Rows.Count, ActiveSheet.UsedRange.Columns.Count)
    Rng.Select
    On Error Resume Next
    Rng.SpecialCells(xlCellTypeConstants).ClearContents
    Application.CutCopyMode = False '
End Sub

Теперь у кода есть аварийный выход: если вы этого не сделаетевведите что-нибудь в InputBox, процедура завершается.Обратите внимание, что новые строки вставляются над BaseRow.После вставки все новые строки и старый ряд идентичны.Затем вы можете выбрать сохранение констант в первой или последней из этих строк, что фактически означает вставку новых пустых строк над или под BaseRow.

...