Copy row and insert n times [Solved/Closed]

Report
-
 sandy -
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

22 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
790
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
ThisWorkbook.Sheets("pending").Rows(1).Copy
in this formula copying only one row, I want one row more just below how it possible