How to duplicate row and insert below based on cell value

Question

How do I use excel VBA to insert a duplicate row below row 1? For example, A1 contains the cell value that corresponds to the number of rows to be duplicated below row 1. If A1 contained a value of 2, I want two rows to duplicate below row 1, containing the same information in row 1, columns B through G.

I tried exploring other VBA forums but could not find applicable VBA.

Answer 1

This should do what you want. You didn't say if you wanted any data currently below row 1 to be overwritten or pushed down, so I've assumed pushed down.

Dim count As Long
count = CLng(Range("A1")) + 1
rows("2:" & count).Insert
Range("b1:g" & count).FillDown

Before image

After image

Answer 2

Alternatively, you could use a range-based for loop.

This should also do the trick:

Range("B1:G1").Select
For i = 1 To Range("A1")
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Next i

(This code deletes values in the area you're pasting to.)

In general, if you want VBA to automate something, record a macro of you doing that something. To do this, you'll have to add the Developer tab to the standard Excel ribbon (File->Options->Customize Ribbon, then check "Developer" in the Main Tabs box). Click "Record Macro" on that tab, then manually do whatever you want to do (you can toggle whether or not you want to use relative references - for your task you wouldn't). Then Click "Stop recording". This creates VBA that does whatever you just did. To run the code, click "Macros" (still on developer tab), and then the name of what you just recorded. You can view the VBA by clicking "Edit" in the "Macros" window.

For issues like yours that inherently involve iteration, record yourself doing one iteration, then add a for loop like above that tells how many iterations you want done. Simply use Range("cellname") to get a cell value, like A1 for your problem.

(I had to do the exact same thing (except with columns) for a business project last year.)

Answer 3

My suggestion would be

Option Explicit

Sub DuplicateRows()
    Dim ws As Worksheet, rg  As Range
    Dim numRows As Variant

    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name
    numRows = ws.Range("A1").Value ' Get the number of rows to duplicate

    ' Check if the value in A1 is a valid number
    If IsNumeric(numRows) And numRows > 0 Then
        With ws
            ' Insert the specified number of rows below row 1.
            .Rows("2:" & numRows + 1).Insert xlDown
            ' Set the range for the newly inserted rows in columns B to G.
            Set rg = Intersect(.Rows("2:" & numRows + 1), .Columns("B:G"))
            ' Copy the content from row 1, columns B to G, to the newly inserted rows.
            .Range("B1:G1").Copy rg
        End With
    Else
        MsgBox "Please enter a valid number in A1", vbOKOnly + vbExclamation, "Error"
    End If
End Sub

Answer 4

I'd loop the rows in reverse order and copy-insert down the current row as many times as needed:

    With Range("A1", Cells(Rows.Count, 1).End(xlUp))
        Dim iRow As Long
            For iRow = .Cells(.Count) To 1 Step -1
                If .Cells(iRow, 1) > 1 Then
                    .Rows(iRow).EntireRow.Copy
                    .Rows(iRow).Resize(.Cells(iRow, 1) - 1).EntireRow.Insert Shift:=xlDown
                End If
            Next
    End With