在原始行下方插入复制的行

Question

我有一个单元格，用户可以在其中输入一个整数，在本例中为 D4。然后我想复制特定数量的行并将它们粘贴到原始单元格下方，次数按照用户输入的指示进行。

我的代码卡在一个循环中，它只是不断地插入单元格，最终 Excel 崩溃，因为我达到了最大行数。我正在尝试复制 4 行并分别粘贴它们 2 次。

以下是代码的副本。

Sub Worksheet_Change(ByVal Target As Range)
    If (Range("D4") <= 1) Then
    End If
    If (Range("D4") > 1) Then
        Dim I As Integer
        Dim SR As Integer
        Dim K As Integer
        Dim NR As Integer
        SR = 6 'starting row
        ER = 4 'number of rows after starting row aka ending row
        NR = 5 'number of rows to inbetween paste operation and original
        For K = 1 To Range("D4") Step 1
            For I = SR To SR + ER Step 1
                Rows(I + NR).EntireRow.Insert
                Rows(I).Copy
                Rows(I + NR).PasteSpecial
            Next I
        Next K
    End If
End Sub

Answer 1

我发现您的代码存在一些问题，因此我对其进行了一些重组和编辑：

Sub Worksheet_Change(ByVal Target As Range)

    Dim WS As Worksheet
    Set WS = ActiveWorkbook.Sheets("Sheet2")

    Dim CellValue As Integer
    CellValue = WS.Range("D4").Value

    If (CellValue <= 1) Then
        MsgBox "Your value is too small. Please enter a new value.", vbOkOnly
        'Exit Sub would also work if you'd want that.
    End If

    If (CellValue > 1) Then
        Dim I As Integer
        Dim SR As Integer
        Dim K As Integer
        Dim NR As Integer
        SR = 6
        ER = SR + 4
        NR = 5
        For K = 1 To CellValue
            For I = SR To ER
                WS.Rows(I).Copy
                WS.Rows(I + NR).EntireRow.Insert
                WS.Rows(I + NR).PasteSpecial
            Next I
        Next K
    End If
End Sub

您知道，每当该工作表 (Worksheet_CHANGE) 发生任何更改时，此代码都会运行。这也意味着每次插入一行时，它都会重新运行 sub。如果你在 D4 旁边放一个可以调用该 sub 的按钮可能会更好。

在原始行下方插入复制的行

Inserting Copied Rows Beneath Original

vba

copy

rows

paste