Report

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

Ask a question JW32 8Posts Friday January 4, 2013Registration date February 21, 2013 Last seen - Last answered on Mar 21, 2017 at 01:07 PM by dm
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


See more 
Helpful
+5
plus moins
Hi JW32,

OK so you want to copy down the values in column E and F down a variable number of times.

How will I know what the variable number is?

Or are columns A to D completely filled till say row 100 and columns E and F are only filled in row 2, 10, 55. And now you wish to copy E2:F2 and paste it to E3:F9 etc.?

Please shine some light on the confusion.

Best regards,
Trowa
Was this answer helpful?  
Josh- Mar 20, 2015 at 08:37 PM
Hi TrowaD,

Could you help me with a similar question...The difference for me is that I want to paste a specific amount of times (100).

So as of now I have,

If Application.WorksheetFunction.CountA("B:B") = 0 Then
[B1].Select
Else
On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks)(1, 1).Select
If Err <> 0 Then
On Error GoTo 0
[B65536].End(xlUp)(2, 1).Select
End If
On Error GoTo 0
End If

Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=NOW()"

And I would like the formula to be pasted the same way overt the next 99 cells so I have 100 cells all in a row with the date and time.
TrowaD 2165Posts Sunday September 12, 2010Registration date ModeratorStatus April 25, 2017 Last seen - Mar 23, 2015 at 12:41 PM
Hi Josh,

To repeat the code you have until you reach row 100, you can add "Do" at the start and "Loop Until ActiveCell.Row = 100" at the end.

If this doesn't suffice then please explain your query in full detail.

Best regards,
Trowa
Helpful
+1
plus moins
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
dm- Mar 21, 2017 at 11:35 AM
hi Trowa,

I am searching for a code that will copy a number 80 times down a column, then move on to the next number and copy that number down 80x.

My inputs are a list (it will change every week) of numbers:
1
3
4
78
98
108

I wish to put these numbers in a column beside it,but repeating the numbers 80 times.

Output:
1
1
1
1
(76 more 1's down)
3
3
3
3
(76 more 3's down)

thank you for any help!
Reply
TrowaD 2165Posts Sunday September 12, 2010Registration date ModeratorStatus April 25, 2017 Last seen - Mar 21, 2017 at 12:15 PM
Hi dm,

Assuming your data is located in column A, then the following code will place the result in column B:
Sub RunMe()
Dim x, y As Integer
x = 1
For Each cell In Range("A1", Range("A1").End(xlDown))
    For y = 1 To 80
        Range("B" & x).Value = cell.Value
        x = x + 1
    Next y
Next cell
End Sub


Best regards,
Trowa
Reply
dm- Mar 21, 2017 at 01:07 PM
Thank you so much Trowa! That's so helpful!!
Reply
Leave a comment
Helpful
+0
plus moins
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
Helpful
+0
plus moins
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
Helpful
+0
plus moins
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 2165Posts Sunday September 12, 2010Registration date ContributorStatus April 25, 2017 Last seen - Feb 25, 2013 at 10:32 AM
Hi Jeanine,

Change the line:
Range("E1:F1").AutoFill Destination:=Range("E1:F" & lRow)
into:
Range("E1:F1").AutoFill Destination:=Range("E1:F" & lRow), Type:=xlLinearTrend

This should prevent the numbers from going up.

Oddity solved, right?

Best regards,
Trowa
Krebs- Mar 8, 2017 at 10:54 AM
Great!!!

It helped me a lot!
Reply
Diddy- Sep 22, 2016 at 07:45 AM
I have a very similar question. I am trying to do a sort of a burn. I need the cell value to be copied linearly across an x amount of rows, and the number or rows that it needs to be copied out lives in another table. How can this be done?
Reply
TrowaD 2165Posts Sunday September 12, 2010Registration date ModeratorStatus April 25, 2017 Last seen - Sep 27, 2016 at 11:30 AM
Hi Diddy,

The code below will take the x amount of rows to be copied from Sheet2 cell A1.
Then takes the value from Sheet1 cell A1 and copies it down the amount found in Sheet2 cell A1.

Here is the code:
Sub RunMe()
Dim CopyX, x As Integer
CopyX = Sheets("Sheet2").Range("A1")
Sheets("Sheet1").Select
Range("A1").Copy

Do
    x = x + 1
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Loop Until x = CopyX
Application.CutCopyMode = False
End Sub


Best regards,
Trowa
Reply
sravan-kr 2Posts Wednesday January 18, 2017Registration date January 20, 2017 Last seen - Jan 18, 2017 at 09:17 AM
what if i want to do the same in columns please reply me as early as possible
Reply
Helpful
+0
plus moins
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
sravan-kr 2Posts Wednesday January 18, 2017Registration date January 20, 2017 Last seen - Jan 20, 2017 at 08:41 AM
Thank you soo much for your reply, instead of copying can we run a macro ??
Reply
TrowaD 2165Posts Sunday September 12, 2010Registration date ModeratorStatus April 25, 2017 Last seen - Jan 23, 2017 at 11:59 AM
"instead of copying can we run a macro "

What do you mean by this? By using the code you are running a macro.
What else do you want to do instead of copying? You want to cut instead of copy?

A confusing question.

Best regards,
Trowa
Reply
SriniPNV 1Posts Thursday January 26, 2017Registration date January 26, 2017 Last seen - Jan 26, 2017 at 11:25 AM
I am facing Similar Problem , need your help

Input

S.No Item Name Unique Number Number of Times
1 Item 1 123 456 ABCD 6
2 Item 2 124 456 ABFF 1
3 Item 3 125 456 ABEE 3


Output

S.No Item Name Unique Number Number of Times
1 Item 1 123 456 ABCD
123 456 ABCD
123 456 ABCD
123 456 ABCD
123 456 ABCD
123 456 ABCD 6




2 Item 2 124 456 ABFF 1


3 Item 3 125 456 ABEE
125 456 ABEE
125 456 ABEE 3

I have input.xlx file , the sheet 1 contains input ,
Need to automate creating Output.xlx file. Please help me
Reply
Leave a comment
Helpful
+0
plus moins
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
jusip16 3Posts Monday March 6, 2017Registration date March 9, 2017 Last seen - Mar 9, 2017 at 12:34 AM
Hi Trowa

Could you help me with a bit similar problem.

I have a sales report provided to me monthly that has the following details: product code, product name, year and month. The format looks like this

l2017 l2017l 2017 l
Code l Name l JAN l FEB l MAR l

I would like to transpose the data to this format using VBA or formulas so that I can do this automatically every month.

Code l Name l Year l Month l Amount l

Also, new product codes and product names are added every month in the report.

Thanks
Reply
TrowaD 2165Posts Sunday September 12, 2010Registration date ModeratorStatus April 25, 2017 Last seen - Mar 9, 2017 at 10:46 AM
Hi Jusip16,

Could you provide a bit more sample data?, as it is unclear to me what needs to go where.

Best regards,
Trowa
Reply
jusip16 3Posts Monday March 6, 2017Registration date March 9, 2017 Last seen - Mar 9, 2017 at 10:41 PM
Hi Trowa,

Sure. Here is a sample data for 2015

l Code l Name l JAN l FEB l MAR l
l 145 l Socks l 20 l 74 l 52 l
l 992 l Bags l 52 l 102 l 278 l

I would like to change it to something like this

l Code l Name l Month l Amount
l 145 l Socks l JAN l 20
l 145 l Socks l FEB l 74
l 145 l Socks l MAR l 52
l 992 l Bags l JAN l 52
l 992 l Bags l FEB l 102
l 992 l Bags l MAR l 278

Thanks again
Reply
Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!