Copy rows and count

M

mudd

Hi,

New to this forum and new to Excel VBA ;-)
This is my problem:
I have a worksheet with five columns, the first has values ending wit
numbers "01". I want to copy the rows, one by one, to anothe
worksheet, 20 times, with the first column incrementing from "01" t
"20". Then the next row with the same incrementing and so on, until th
end of the range.

Regards,
Ralph Utbul
 
M

mrice

Try something like

Sub Test()
Set DataRange = Range(Cells(1, 1), Cells(100, 1))
For Each Cell In DataRange
For N = 1 To 20
Sheets("Sheet2").Cells(65536, 1).End(xlUp).Offset(1, 0) =
Left(Cell, Len(Cell) - 2) & Left("00", 2 - Len(N)) & N
Range(Cells(Cell.Row, 2), Cells(Cell.Row, Cells(Cell.Row,
256).End(xlToLeft).Column)).Copy
Destination:=Sheets("Sheet2").Cells(65536, 1).End(xlUp).Offset(0, 1)
Next N
Next Cell
End Sub

This will create a list on the second sheet with the 20 values stacked
beneath each other. I assume that this is what you wanted.
 
M

mudd

mrice said:
Try something like


Range(Cells(Cell.Row, 2), Cells(Cell.Row, Cells(Cell.Row,
256).End(xlToLeft).Column)).Copy
Destination:=Sheets("Sheet2").Cells(65536, 1).End(xlUp).Offset(0, 1)

This will create a list on the second sheet with the 20 values stacked
beneath each other. I assume that this is what you wanted.

Thanks!
It worked great, with a small amount of customization, of course ;-)
I narrowed the area that gets copied:
Range(Cells(Cell.Row, 14), Cells(Cell.Row, 18)).Copy
destination:=Sheets("Sheet2").Cells(65536, 1).End(xlUp).Offset(0, 1)

My code has cut time from two hours to 5 minutes and gotten rid of the
mistakes involved in tedious, repititive work. I'm really happy about
this!

Regards,
Ralph
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top