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

 

[tomtomsf]

Bingo! I think that is it! It seems to be working properly! Thanks again, Brian. I appreciate your help.

Tom G.

 

[Embrodak]

I have a similar problem that I need some help with. I have a label program that reads from an excel sheet. The number of labels is determined by the number of rows.

I have two sheets, Info and Label.
Various information is entered in the Info Sheet.
One of the cells (x) is the number of labels to be printed. (=Info!D12)

On the Label Sheet a1:e1 is just header info and ignored.
a2:e2 is where I take the information in and insert it (with some concatenate function)

I have data in A3:E3 that add 1 (for a serialization) and I want this row copied down (X-2) times, starting in A4:E4. the -2 is taking into

I tried to take some of the stuff above and came up with this (but it doesn't work) The text in Red is what is not working. Not sure how to have copied what was written before.

Sub Number()
Range("4:5000").Select
Selection.ClearContents
Dim x As Integer
x = 10
Sheets("Label").Select
Range("A3:E3").Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Range(a4, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub

 

[meldoc]

Hello and Welcome to MrExcel

Sorry I'm not sure that I fully understand what you require, try the below on a COPY, of your data.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Number()<br>  Sheets("Label").Range("4:5000").ClearContents<br>  <SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>  x = 10<br>  Range("A3:E3").AutoFill Destination:=Range("A3:E" & x + 1), Type:=xlFillDefault<br>  Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Embrodak]

That last one is doing exactly what I wanted it to do.. Except I was not clear enough in my original explanation.

I has "x = 10" as a place holder because I was not sure how to code it, and forgot to mark that I wanted it changed.

I want x to equal (Info!D12)

I put in x = Info!D12, but that didn't work and I am not sure of the syntax.

 

[Embrodak]

Wow.. Nevermind I figured it out. As soon as I posted the above I tried this by trying to emulate other syntax

x = Sheets("Info").Range("D12")

So the whole macro was

Sub Number()
Sheets("Label").Range("4:5000").ClearContents
Dim x As Integer
x = Sheets("Info").Range("D12")
Sheets("Label").Range("A3:E3").AutoFill Destination:=Sheets("Label").Range("A3:E" & x + 1), Type:=xlFillDefault
Application.CutCopyMode = False
End Sub


I also added the Sheets("Label"). as I will be running this off a different sheet I want to make sure it is running on the "Label" sheet.
Thanks for the help.

 

[meldoc]

You're welcome

Glad you worked it out.

 

[bubbahotep]

the script is helping me (so thanks a lot!) but when inserting more than 30,000 rows it crashes. anyway to extend that ?

 

[meldoc]

Hello and welcome,

Yes, Try this.

<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">Long</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></FONT>

 

[VikasMExcel]

Can we add to have the inserted rows colored yellow to differentiate them form the orignal where they were copied form.

 

[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">Long</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>    Range(ActiveCell.Offset(1), ActiveCell.Offset(x)).EntireRow.Interior.ColorIndex = 6<br>    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>