Copy row and insert n times Solved/Closed

Question

Hello,
I have an example below, I'd like to take the first row, copy it "n" number of times, then take the next row copy it the same "n" number of times, till the end of the rows.

Sample
ColA         ColB        ColC
TextA        TextA1    TextA2
TextB        TextB1     TextB2
TextC        TextC1     TextC2

Results (for example 3 times)
ColA         ColB        ColC
TextA        TextA1    TextA2
TextA        TextA1    TextA2
TextA        TextA1    TextA2
TextB        TextB1     TextB2
TextB        TextB1     TextB2
TextB        TextB1     TextB2
TextC        TextC1     TextC2
TextC        TextC1     TextC2
TextC        TextC1     TextC2

venkat1926 · Accepted Answer

It is a bother to modify a already created  macro even it it is one's own. 
I have given you another macro similar to one given before. 

Sub test()

Dim rng As Range, c As Range
Dim rng1 As Range, c1 As Range
Dim dest As Range, j As Integer, k As Integer
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
Set rng = Range(.Range("A2"), .Range("A2").End(xlDown))
j = WorksheetFunction.CountA(.Rows("1:1"))
'msgbox j
For Each c In rng
Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft))
'msgbox rng1.Address
For Each c1 In rng1

Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
'msgbox dest.Address
If c1 = "" Then GoTo line1
'dest.Offset(0, 0) = c
'dest.Offset(0, 1) = .Cells(1, c1.Column)
'dest.Offset(0, 2) = c1
dest = c
dest.Offset(0, 1) = c1
dest.Offset(0, 2) = .Cells(1, c1.Column)
line1:
Next c1

Next c
End With
With Worksheets("sheet2").Columns("c:c")
.NumberFormat = "dd-mmm-yy"
End With
End Sub

venkat1926 · Answer

try this macro 

Sub test()
Dim n As Integer, rng As Range
n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
Range(rng.Offset(1, 0), rng.Offset(3, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"
End Sub

venkat1926 · Answer

it works in my case. do an experiment open a new workbook.
type a in a1 and s in A2 and d in a3 and f in a4. now copy paste my macro in this workbook's vb editor and then run the macro . in the inptbox type for example 3 .  Do you not get what you want . that is a repated 3 tiems, s repeated 3 times etc. 



 Then you can find out what is the problem in your workbook 

a
s
d
f

islandman63 · Answer

Venkat,

Your absolutely right it works on the example great.  How do I attach a file so I can use the real file to tweak?

venkat1926 · Answer

1.open your file
2. open vb editor (alt+F11)
3.control+R
4.in the left side window highlight your file name
5. click insert(in the menu bar of vb editor)-module 
6.there you copy paste the macro
7. save teh file
8. now you run the macro( I am sure you know how to do it)

any doubts post back

venkat1926 · Answer

try this 

Sub test()
Dim n As Integer, rng As Range
'n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
n = InputBox("type no. of times you want to be repeated minus 1 for e.g if you wnat to be repeated 3 times type 2")
Range(rng.Offset(1, 0), rng.Offset(n, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"

End Sub

Netscur · Answer

I have a problem that might be similar to the history in this forum entry.


I create a forecast for parts in a cross tabular format (example below)
ColA       ColB       ColC       ColD       ColE

Part 1     Month1   Month2   Month3   Month4
Part 2     Month1   Month2   Month3   Month4
Part 2     Month1   Month2   Month3   Month4



To load the forecast into my Enterprise software program, I need the data to be tabular:
ColA       ColB       

Part 1     Month1
Part 1     Month2
Part 1     Month3
Part 1     Month4
Part 2     Month1
Part 2     Month2
Part 2     Month3
Part 2     Month4
Part 3     Month1
Part 3     Month2
Part 3     Month3
Part 3     Month4
Part 4     Month1
Part 4     Month2
Part 4     Month3
Part 4     Month4


The number of "parts" varies month to month; I would like to define it when the macro first runs.  In my example, there were 4 parts.

Most of the time I create a forecast for '12 months' but it would be more useful to also define the date range when the macro runs.  In my example, there were just 4 months.


Finally, I would prefer that the macro paste the data in a 'new worksheet' (rather than over write my forecast data worksheet).



Any help would be of immense use.  Thank you!

venkat1926 · Answer

Netscyr

this is the macro 

Sub test()
Dim rng As Range, c As Range
Dim rng1 As Range, c1 As Range
Dim dest As Range, j As Integer, k As Integer
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
Set rng = Range(.Range("A2"), .Range("A2").End(xlDown))
j = WorksheetFunction.CountA(.Rows("1:1"))
'msgbox j
For Each c In rng
Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft))
'msgbox rng1.Address
For Each c1 In rng1

Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
'msgbox dest.Address
If c1 = "" Then GoTo line1
dest.Offset(0, 0) = c
dest.Offset(0, 1) = .Cells(1, c1.Column)
'dest.Offset(0, 2) = c1
line1:
Next c1

Next c
End With
End Sub


another method -pivot table of database.-
ref: wlakenbach blog 
http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

Netscur · Answer

Aces... with minor tweaking for my 'real' document, it WORKS great, and I understand 50% of how it works :)


There is one last ‘need’ for my Enterprise upload... the DATE found in and across “Row 1, ‘$A$2:$A*’”

I need the macro to take the Rawdata, which is the forecast in cross tabular form (see below)
Rawdata:
ColA         ColB          	ColC         	ColD

Item	6/1/2009	7/1/2009	8/1/2009
Part 1	50	  	55		6
Part 2	1		5		10



and produce the following results:
sheet2:
ColA	ColB	ColC

Part 1	39965	6/1/2009
Part 1	39995	7/1/2009
Part 1	40026	8/1/2009
Part 2	39965	6/1/2009
Part 2	39995	7/1/2009
Part 2	40026	8/1/2009


With what you provided me (THANK YOU SO MUCH) I am able to create ColA & ColB.  
If I need to, I am able to copy & paste special ("transpose") the date range from the Rawdata.  Unfortunately, when I have hundreds of parts it is just a little time consuming… so if the action can be incorporated into the macro, it would make my job go even faster.

Thank you again.  Just so you don't think I am a leach wasting your talent, I have already signed up for Tutorial Excel & Access lessons with our Microsoft IS/IT package.  Being able to do what you created will definitely make me more valuable.

Netscur · Answer

I apologize, I miss typed in my sample/request above....



I need the additional macro lines to take the Rawdata, which is the forecast in cross tabular form (see below) 
Rawdata: 
ColA        ColB        ColC        ColD 

Item 	6/1/2009	7/1/2009	8/1/2009 
Part 1 	50	55	6 
Part 2 	1	5	10 

("Item", "6/1/2009", "7/1/2009, "8/1/2009" are headers) 


and produce the following results: 
sheet2: 
ColA 	ColB 	ColC 

Part 1	50	6/1/2009 
Part 1	55	7/1/2009 
Part 1	6	8/1/2009 
Part 2	1	6/1/2009 
Part 2	5	7/1/2009 
Part 2	10	8/1/2009



As my lack of knowledge regarding macros is abundant, perhaps this is an entirely different macro than the first you provided.  No matter what, I appreciate your guidence and effort!

Netscur · Answer

WOW, everything I needed!!!  Thank you kindly!  

Just out of curiosity, are you self taught or have you taking some training to write in Visual Basic so fluently?
Netscur (Minneapolis, MN)

venkat1926 · Answer

I am only self taught. that is why I am not an expert. I suggest to learn vba  just RECORD macro following the steps you want take and edit the macro   This is the best way to learn vba.  any doubt go to google search. and also take help of forums.

alokk · Answer

sorry the start date on the last row should state 25-09-09

venkat1926 · Answer

I have added two more rows to check my macro. This is in SHEET1 as follows

Start Date	End Date	Start Time	End Time	Group	Sub Group	Details	Manager
9/23/2009	 9/25/2009	10:00 AM	11:00 AM	Class X	section 1	Goes for preparation	Teacher 1
9/27/2009	 9/29/2009	10:00 AM	11:00 AM	class xi	section 1	xxxxxxx	teacher 2
10/2/09  10/6/2009	10:00 AM	11:00 AM	class xi	section 1	xxxxxxx	teacher 2

carefully type this in sheet1

copy  this data in sheet 2 also from A1 to retrieve for rechecking 
KEEP SHEET1 AS ACTIVE SHEET
now run this macro "test"  and see whether you get what you want in sheet1.

if you want to recheck.
1. run the macro "undo"
and then
2. run the macro "test"(ALWAYS KEEPING SHEET 1 AS ACTIVE SHEET)

Sub test()
Dim j As Integer, k As Integer, m As Integer, n As Integer
j = Range("a1").End(xlDown).Row
'j is hte lsst row
k = j
Do
If k = 1 Then Exit Do
m = Cells(k, "b") - Cells(k, "A")
'MsgBox m
'Range(Cells(k + 1, "A"), Cells(k + m, "A")).Select
Range(Cells(k + 1, "A"), Cells(k + m, "A")).EntireRow.Insert

For n = 1 To m
Cells(k, 1).EntireRow.Copy Cells(k + n, 1)
Next n

For n = 1 To m

Cells(k + n, 1) = Cells(k, 1) + n
Next n
k = k - 1
'MsgBox k
Loop
End Sub
Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").UsedRange.Copy Worksheets("sheet1").Range("A1")

End Sub

any bug  post back. if ok confirm

theman · Answer

I'm trying to do something very similar but MUCH simpler I think.

I would like to use cell A1 to put text into, Cell B1 to put the n number of times to repeat cell A1, and have the output added to column C

For example:

ColA      ColB      ColC
A1 text   5         A1 text
                        A1 text
                        A1 text
                        A1 text
                        A1 text

Then you leave Col C alone and clear out A and B. Put in new input to get the following for example:

ColA ColB ColC
A1new 7 A1 text
A1 text
A1 text
A1 text
A1 text
A1new
A1new
A1new
A1new
A1new
A1new
A1new
</code>

You can keep using it to create one big long column of entries. I'd gladly send someone some $$ via paypal for the help if it's done in the next few hours.

venkat1926 · Answer

Therman
your second message is confusing 

the data is in A1 to B2 is 

A1 text	5
a1 new	7

now run this macro 

Sub test()
Dim x As Integer, r As Range, r1 As Range, c As Range
Dim dest As Range
Set r = Range(Range("A1"), Range("A1").End(xlDown))
For Each c In r
x = Cells(c.Row, "B").Value
Set dest = Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)

Set r1 = Range(dest, dest.Offset(x - 1, 0))
r1.FormulaArray = c.Value
Next c
Range(Range("c2"), Range("c2").End(xlDown)).Cut Range("c1")
End Sub


the result will be 

A1 text	5	A1 text
a1 new	7	A1 text
		A1 text
		A1 text
		A1 text
		a1 new
		a1 new
		a1 new
		a1 new
		a1 new
		a1 new
		a1 new

I guess that the members of this newsgroup are volunteers.

venkat1926 · Answer

the thread has become too long and dated also. for the next problem start a new thread

the data base is like this 

hdng1	hdng2	hdng3
Test1	Test2	2
Test3	Test4	3

copy this data in sheet 3----IMPORTANT 
WHEN YOU WANT TO RUN THE MACRO TO  YOUR ORIGINAL FILE KEEP A COPY SAFELY SOMEWHERE SO THAT IF THERE IS A MESS UP  THE ORIGINAL DATA CAN BE RETRIEVED

the macro is 

Sub test()
Dim r As Range, c As Range, j As Long, k As Long, m As Long
Worksheets("sheet1").Cells.Clear
Worksheets("sheet3").Cells.Copy Worksheets("sheet1").Range("A1")
Worksheets("sheet1").Activate
Set r = Range(Range("A2"), Range("B2").End(xlDown))
j = Range("A2").End(xlDown).Row
'j is last row
For k = j To 2 Step -1
m = Cells(k, "C")
'MsgBox m
Range(Cells(k + 1, "A"), Cells(k + m - 1, "A")).EntireRow.Insert
Range(Cells(k, "A"), Cells(k, "B")).Copy
Range(Cells(k, "D"), Cells(k + m - 1, "d")).PasteSpecial
Next k
Application.CutCopyMode = False
Range("A1").Select
End Sub

tmiddlemas · Answer

venkat1926,

The macro you provided below is really close to what I need. 

Sub test()
Dim n As Integer, rng As Range
n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
Range(rng.Offset(1, 0), rng.Offset(3, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"
End Sub


My data is formatted a little differently I think.  My data is currently provided as:

Code1  Description 1
Code2  Description 2
Code3  Description 3

What I need is to insert and copy each row x number of times as shown (example showing three rows):

Code1  Description 1
Code1  Description 1
Code1  Description 1
Code2  Description 2
Code2  Description 2
Code2  Description 2
Code3  Description 3
Code3  Description 3
Code3  Description 3

The macro you provided gives me:

Code1  Description 1
Code1  Description 1
Code1  Description 1

Then it ends.  Is there a way for it to loop through all rows?

Thanks in advance.  Macros are totally new for me and I'm looking at manual cut/paste this weekend if I can't figure this out.

Thanks!

venkat1926 · Answer

suppose your data is like this from A1 down and right in sheet1

hdng1	hdng2	hdng3
Code1	Description	1
Code2	Description	2
Code3	Description	3

copy data in sheet1 to sheet 3
WHEN YOU FINALLY USE THIs macro IN YOUR ORIGINAL FILE  PLEASE KEEP A COPY SAFELY SOMEWHERE.
In the macro there is a staemnt 
m=3
you can change it if you want (but first test the macro as it is )


The macro is 

Sub test()
Dim j As Integer, k As Integer
Dim m As Integer
m = 3
Worksheets("sheet1").Cells.Clear
Worksheets("sheet3").Cells.Copy
Worksheets("sheet1").Range("A1").PasteSpecial
Worksheets("sheet1").Activate

j = Range("a1").End(xlDown).Row
For k = j To 2 Step -1
Range(Cells(k + 1, 1), Cells(k + m - 1, 1)).EntireRow.Insert
Cells(k, 1).EntireRow.Copy
Range(Cells(k + 1, 1), Cells(k + m - 1, 1)).PasteSpecial
Next k
Application.CutCopyMode = False
Range("A1").Select
End Sub

venkat1926 · Answer

BRI this is reply to BRI

you should have opened a new thread.


I have multiple worksheets within the workbook that I would like to link to the "CURRENT" worksheet

This is not clear. I am rephrasing sit. See whether I reflect your ideas.

There are many sheet let us gallaher1, gallaher 2 etc with yes or no in column D of each of these sheets. There is also another unique sheet called "current".  You have filter out the rows containing "no" in column D of gallaher sheets and copy it to the now empty sheet current. 

I have configured a sample workbook which you can download from the following web page. 

https://authentification.site/files/23681915/Bri.xls

The sheet current is after running the macro "test"

For rechecking you can again run the macro "test". It clears the entries in "current" and again fills its up with filtered data. 

When writing the criteria in the macro the spelling and the case should be correct. 

The macro is 

Sub test()
Dim r As Range, dest As Range, j As Integer, k As Integer
Dim r1 As Range
j = Worksheets.Count
Worksheets("current").Cells.Clear
For k = 1 To j
If Worksheets(k).Name = "Current" Then GoTo nextk
With Worksheets(k)
Set r = .UsedRange
r.AutoFilter field:=4, Criteria1:="No"
Set r1 = r.Offset(1, 0)
MsgBox r.Address
r1.Cells.SpecialCells(xlCellTypeVisible).Copy
With Worksheets("current")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With

r.AutoFilter
End With
nextk:
Next k
Worksheets("Gallaher1").Range("A1").EntireRow.Copy
Worksheets("current").Range("A1").PasteSpecial
End Sub

venkat1926 · Answer

Copydown

quote
I would really like to use this - it's exactly what I'm trying to do (putting the results onto a new page). But I keep getting errors. Any ideas? I need to paste the value in column A the # of times listed in Column B into Sheet2
unquote

It is very confusing to me. please start a new thread in the newsgroup and explain clearly  your requirements. Some macros are customized for certain files

sandy · Answer

ThisWorkbook.Sheets("pending").Rows(1).Copy

Copy row and insert n times

22 responses

Similar discussions

Subscribe To Our Newsletter!