CODEWITHSUNDEEP
vbacopyrowspaste
RoboNerd
RoboNerd

Reputation: 25

Inserting Copied Rows Beneath Original

I have a cell in which a user inputs a whole number, in this case D4. I then want to copy a specific number of rows and paste them beneath the original cells the number of times as indicated by the user input.

I have code that gets stuck in a loop where it just continuously inserts cells and eventually Excel crashes because I reached the maximum number of rows. I'm trying to copy 4 rows and paste them 2 separate times.

The following is a copy of the code.

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

Upvotes: 0

Views: 57

Answers (1)

Kathara
Kathara

Reputation: 1290

I've seen some problems in your code, so I reorganized and edited it a bit: 

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

And for you to know, this code will be run every time anything changes on that worksheet (Worksheet_CHANGE). This also means that each time a row gets inserted it will rerun the sub. It would probably be better if you would put a button next to D4 which can call that sub.

Upvotes: 1

Related Questions