VBA公式用公式添加新行

Question

谁能帮我调整这段代码来修复我的解决方案？

我有一个按钮，可以从 A5 向下添加 x 数量的新行。 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

Answer 1

请尝试以下代码。它将复制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 上方或下方插入新的空白行。