Better yet, why don't you copy the code I posted and replace the code you are
using with it. That way you eliminate the typos or omissions.

"Steve" wrote:

Thanks JLGWhiz, but this is still giving me inaccurate results.
I selected rows 10 & 20, but it only copied row 10 twenty times.


On Mar 6, 11:04 am, "JLGWhiz" wrote:
OK Steve, This should now list each of your selected ranges 10 time with the
correct row being copied.

Sub CopySelection10Times()

Dim myRange As Range
Dim rng As Range
Dim strNewRange As String
Dim i As Long
Dim j As Long
Dim wksto As Worksheet
Dim lngRangeCount As Long
Dim testVar

On Error Resume Next
Set wksto = ThisWorkbook.Sheets("Metro AHK New")
Set myRange = Application. _
InputBox("Select data to Copy", , , , , , , 8)
If myRange Is Nothing Then
Exit Sub
Else
End If
lngRangeCount = UBound(Split(myRange.Address, ","))
For i = 0 To lngRangeCount
strNewRange = Split(myRange.Address, ",")(i)
Set rngLoopRange = Range(strNewRange)
If rngLoopRange Is Nothing Then
Set rngLoopRange = myRange
End If
For j = 1 To myRange.Rows.Count
rngLoopRange.EntireRow.Copy _
wksto.Cells(wksto.Rows.Count, 1) _
.End(xlUp).Offset(1, 0) _
.Resize(10, wksto.Columns.Count)
Next
Next

Application.CutCopyMode = False

End Sub

"Steve" wrote in message

...

I was given the below code which is supposed to allow me to select a
range of rows from a worksheet via an input box method and copy each
selected row sequentially 10 times. It was coded to allow me to select
non adjacent rows. Problem is it copies the wrong rows. For example,
when I select rows 10 & 20 from a sheet, the procedure copies rows 9 &
10. I tried to debug it to find the error, but I was unable. Can
anybody help, or supply different code which will allow copying a
range of non adjacent rows and copy them 10 times sequentially via
input box?

Thanks...

---------------------------------------------------------------------------------------<

Sub CopySelection10Times()

Dim myRange As Range
Dim rng As Range
Dim strNewRange As String
Dim i As Long
Dim j As Long
Dim wksto As Worksheet
Dim lngRangeCount As Long
Dim testVar

On Error Resume Next
Set wksto = ThisWorkbook.Sheets("Metro AHK New")
Set myRange = Application.InputBox("Select data to Copy
", , , , , , , 8)

If myRange Is Nothing Then
Exit Sub
Else
End If

lngRangeCount = UBound(Split(myRange.Address, ","))
Debug.Print lngRangeCount

For i = 0 To lngRangeCount

strNewRange = Split(myRange.Address, ",")(i)

Set rngLoopRange = Range(strNewRange)

If rngLoopRange Is Nothing Then
Set rngLoopRange = myRange
End If

Debug.Print rngLoopRange.Address

For j = 1 To myRange.Rows.Count
myRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
Next
Next

Application.CutCopyMode = False

End Sub