Macro to copy/paste down X times (where X is the number of rows) Solved/Closed

Question

Hello, 

I could sure use some help on a Macro.

I need to copy the value in E1 and paste down to all cells in column E  (E2 to E??)

The issue is - the number of rows will change.

One time it might need to copy down 5 times.  Another it might need to copy down 40 times.

I would also need it to do nothing if there is only 1 row (Nothing to copy if the source is the only row!!)

I case it matter you - I would repeat the exact process for Column F.  Copy F1 and paste down to all cells in column F (F2 to F??).  

We can NOT copy the row as the information in A to D must not be manipulated.

Thank you very much for your time!
Jeanine


Configuration: Windows 7 / Firefox 18.0

TrowaD · Accepted Answer

Hi Jusip16, As per your sample data, the following code will do as requested. The result will be placed in a second sheet. First sheet is called Sheet1 and the second sheet is called Sheet2. Either name your sheets like that or find those sheet references in the code and change them to match your (easily done by selecting entire code [CTRL+a] and use the find/replace window [CTRL+h]). Here is the code: Sub RunMe() Dim x, lRow As Integer lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Sheets("Sheet1").Select With Sheets("Sheet2") Do x = x + 1 If Cells(x, "C").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "C").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "C").Value End If If Cells(x, "D").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "D").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "D").Value End If If Cells(x, "E").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "E").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "E").Value End If If Cells(x, "F").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "F").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "F").Value End If If Cells(x, "G").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "G").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "G").Value End If If Cells(x, "H").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "H").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "H").Value End If If Cells(x, "I").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "I").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "I").Value End If If Cells(x, "J").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "J").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "J").Value End If If Cells(x, "K").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "K").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "K").Value End If If Cells(x, "L").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "L").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "L").Value End If If Cells(x, "M").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "M").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "M").Value End If If Cells(x, "N").Value <> vbNullString Then .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "A") .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets("Sheet1").Cells(x, "B") .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(1, "N").Value .Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(x, "N").Value End If Loop Until x = lRow End With End Sub Best regards, Trowa Monday, Tuesday and Thursday are usually the days I'll respond. Bear this in mind when awaiting a reply.

JW32 · Answer

Hi!

It is always so hard to describe things.  What was clear in my mind - is obviously not clear to another!

If I can get this to work - this macro will actually be in the middle of a much larger macro that actually works (except this one important step)!

Sheet 1 has data.  What shows up on Sheet 1 is a result of some look ups.  Not part of a Macro at all.  It is dog information.  Name and Owner (and a few other bits).  So the user keys in a number and up pops all the information from the database about that dog.  How many lines pop up could be 1 or any number up to about 250.  

The Macro I have copies these lines to another sheet.  Sheet 2.  Sheet 2 will have columns A to G.  And as I said - an undetermined number of lines.  As many lines as there are records for the dog in the database.

Sheet 2 only has the lines copied from Sheet 1.  Meaning there are no lines with spaces or blanks.  Only the results from page 1 are on page 2.  They get copied in by my Macro.

So now we are on sheet 2.  Lets for my example say we copied in 11 rows.

I need the value in E1 and F1 to be copied down 10 times (11-1).  So that all 11 rows have the same value in Column E and F.

The values in the other columns can not be change.

How many times do we have to copy?  The same number of times as there are rows in sheet 2.

To illustrate.  Below are the values in E and F only (example 4 rows)

Suzy     John
Harry    Max
Shevy   Twinkle
Max      Rover

The above is what came to sheet 2 via a copy.

I want the result to be:

Suzy    John
Suzy    John
Suzy    John
Suzy    John

Each time the Macro runs will have a different number of rows to copy down.  And of course if there is only one row (which is possible!!) there is not need to copy anything as the correct information is in that row.

I hope this is a better explanation.

Thank you for your time!!
Jeanine

TrowaD · Answer

Hi Jeanine,

Things got a lot clearer!

Good to tell this is part of a code.
I don't know on which sheet you are when this part of the code is activated, so I started out with referring to the correct sheet.

Second, when only 1 row exists nothing should be done. Normally I would exit sub, but now the code will skip the autofill part and continue with the code.

So just make sure the variable lRow isn't used before and/or is ok to be changed and this code is safe to implement as part of your code (of course without the Sub and End Sub parts).

Sub CopyValueDown()
Dim lRow As Integer

Sheets("Sheet 2").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
If lRow = 1 Then GoTo NextPartOfCode
Range("E1:F1").AutoFill Destination:=Range("E1:F" & lRow)
NextPartOfCode:
End Sub

Good luck with your code and let me know if more assistance is desired.

Best regards,
Trowa

JW32 · Answer

Trowa!!  

This is great!  It is almost perfect.  Actually it was perfect until I just ran for the 14th time.  

As it turns out there are some records where the last character in E1 has a #.

Such as:

Suzy3   John

When I use your code - if it says only Suzy John it works perfectly.

If it Says Suzy3 John it increments the last digit.

So I ended up with: 

Suzy3 John
Suzy4 John
Suzy5 John
Suzy6 John

When I needed:

Suzy3 John
Suzy3 John
Suzy3 John
Suzy3 John

I am so sorry I didn't realize this might happen.  The data has about 12K lines so  I didn't notice that some records end with a number.

Is there a way to adjust for this oddity?

Thank you!
Jeanine

TrowaD · Answer

Hi Sravan-kr,
"what if i want to do the same in columns please reply me as early as possible"

For that request try this:
Sub RunMe()
Dim CopyX, x As Integer
CopyX = Sheets("Sheet2").Range("A1")
Sheets("Sheet1").Select
Range("A1").Copy

Do
    x = x + 1
    Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
Loop Until x = CopyX
Application.CutCopyMode = False
End Sub 
Best regards,
Trowa

TrowaD · Answer

Hi SriniPNV,
The following code will keep the format of your input data.
Here it is:
Sub RunMe()
Dim x, y, z As Integer

x = Range("D" & Rows.Count).End(xlUp).Row

For y = x To 2 Step -1
    z = Cells(y, "D").Value - 1
    Do Until z = 0
        Rows(y).Copy
        Rows(y).Insert Shift:=xlDown
        z = z - 1
    Loop
Next y
Application.CutCopyMode = False
End Sub
Best regards,
Trowa

TrowaD · Answer

Hi Robert,

Sure, must have slipped my attention.

Assuming a second sheet is created with header.
In the code the source sheet is called: Sheet1.
And the destination sheet is called: Sheet2.

Here is the code:
Sub RunMe()
Dim mCol, mRow As Integer

Sheets("Sheet1").Select

For Each cell In Range("A2:A" & Range("A1").End(xlDown).Row)
    mRow = cell.Row
    mCol = 2
    Do
        mCol = mCol + 1
        If Cells(mRow, mCol) <> vbNullString Then
            Range(Cells(mRow, "A"), Cells(mRow, "B")).Copy _
            Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Cells(1, mCol).Copy Sheets("Sheet2").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
            Cells(mRow, mCol).Copy Sheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
        End If
    Loop Until Cells(mRow, mCol) = vbNullString
Next cell
End Sub


Best regards,
Trowa

TrowaD · Answer

Hi Tanya,

Here is the amended code:
Sub ToyNumber()
Dim toy, i As Integer

toy = 3 'changed 1 to 3, to start pasting from row 3.

For Each cell In Range("A1", Range("A1").End(xlDown))
    For i = 1 To 14
        Sheets("Result").Range("A" & toy).Value = cell.Value 'reference to the Result sheet added, also changed B to A.
        toy = toy + 1
    Next i
Next cell
End Sub

That should do it, right?

Best regards,
Trowa

TrowaD · Answer

Hi Annonyman,

Give the following code a try:
Sub RunMe()
Dim x As Integer

x = Range("B4").Value

Range("A9:M9").AutoFill Destination:=Range("A9:M" & 9 + x)

End Sub

Best regards,
Trowa

TrowaD · Answer

Hi Syapinme,

Give the following code a try:
Sub RunMe()
Dim x As Integer

x = Range("A2").Value

Do
    Columns("E:H").Copy
    Columns("E").Insert
    x = x - 1
Loop Until x = 0

Application.CutCopyMode = False

End Sub

Best regards,
Trowa

Macro to copy/paste down X times (where X is the number of rows)

10 responses

Similar discussions

Subscribe To Our Newsletter!