Question

我有一个列表，其中包含一定数量的行并包含行中的公式。我有一个输入框，它会询问用户他们想要输入多少行，并将它们添加到顶部。我想更改这个以复制行（使用公式和没有值）并将它们粘贴到工作表的底部，在“按钮上方添加更多行”上方。我被卡住了，请帮忙：

Private Sub CommandButton1_Click()
    Dim j As Long, r As Range

    On Error GoTo Canceled
    j = InputBox("Type the Number of Rows to be Inserted")
    Set r = Range("A1")

    Do
        Range(r.Offset(1, 0), r.Offset(j, 0)).EntireRow.Insert
        Set r = Cells(r.Row + j + 1, 1)
        If r.Offset(1, 0) = "" Then Exit Do
    Loop
Canceled:
End Sub

Answer 1

编辑4/19：代码现在将行添加到数据块的底部（而不是顶部）：

Option Explicit
Private Sub CommandButton1_Click()
Dim j As Long, Index As Long, LastRow As Long, _
    LastCol As Long
Dim r As Range, DragDown As Range
Dim MyWorksheet As Worksheet

'set variables up front for easy reference
Set MyWorksheet = ThisWorkbook.ActiveSheet
LastCol = MyWorksheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = MyWorksheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set r = Range(MyWorksheet.Cells(LastRow, 1), MyWorksheet.Cells(LastRow, LastCol))

On Error GoTo Canceled
j = InputBox("Type the Number of Rows to be Inserted")

'simulate user dragging the bottom row down
Set DragDown = Range(MyWorksheet.Cells(LastRow, 1), MyWorksheet.Cells(LastRow + j, LastCol))
r.AutoFill Destination:=DragDown

Canceled:
End Sub

用于复制单元格并在底部插入的输入框

1 个答案: