copy & insert row n times

[tomtomsf]

Hi Excel Users,

I need a macro that will copy a row to "n" number of identical rows below it, depending on user input. I am not skilled at VBA but I cobbled together some code I found online (see below). Unfortunately, it does not work properly. The input box pops up, but it only copies one new row regardless of what number you enter. Can anyone kindly help me out with this?

Tom G.

Sub InsertCopyRow2()
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
End Sub

 

[Maheshp]

Hope this will help

Sub InsertRows()
Dim x As Integer
x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1)
Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown
End Sub

http://www.mrexcel.com/forum/showthread.php?t=123108http://<a href="http://www.mrexcel....mrexcel.com/forum/showthread.php?t=123108</a>

 

[tomtomsf]

Hi There

Thak you for your reply but it does not do what I need. Your macro inserts blank rows above a selected cell/row.

I need the macro to copy an existing row (both data and formulas) and copy it below that row x number of times.

I appreciate your reply but I hope someone can help me figure this out.

Tom G.

 

[Maheshp]

Hi
Try

Sub test()
Dim x As Integer
x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1)
ActiveCell.EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown
End Sub

 

[tomtomsf]

Yes! That does work! It does what I need.

Now, if I can ask one more thing... Is it possible to make it so that the selected row that is copied does not remain selected after the macro runs? It's a minor thing, but would be nice if you know how to do that.

Thank you so much for your help on this!

Tom G.

 

[tomtomsf]

Ooops! One other slight problem. If you hit "Cancel" instead of entering a number for Number of Rows, the macro still inserts 2 new rows anyway.

Tom G.

 

[meldoc]

Hello

Try.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> test()<br><SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>  x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1)<br>  <SPAN style="color:#00007F">If</SPAN> x = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    ActiveCell.EntireRow.Copy<br>    Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown<br>    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[tomtomsf]

Perfection, Brian! Thank you so much for getting it right for me. It works beautifully.

I do appreciate all the help from both of you Excel geniuses!

Tom G.

 

[tomtomsf]

Uh, oh! While it appears to work almost perfect, it messes up the formulas. The data gets copied but the formulas do not. Any idea how to fix that?

Tom G.

 

[meldoc]

Yes sorry about that, I tested with a simple in cell formula IE "=2+2", and it worked.

Try this version, and use absolute or mixed cell references in your formulas.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> test()<br><SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>  x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1)<br>  <SPAN style="color:#00007F">If</SPAN> x = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    ActiveCell.EntireRow.Copy<br>    Range(ActiveCell.Offset(1), ActiveCell.Offset(x)).EntireRow.Insert<br>    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>