Sorry, I meant Matt...

On Mar 5, 2:47*pm, Steve wrote:
Thanks Bill.

However; this copies the wrong rows. If I select rows 10 & 20, it
copies 9 &10.

On Mar 5, :

On Mar 5, 11:14*am, Steve wrote:

I have the below procedure which allows me toselecta range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me toselect
multiplerows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

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

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim i As Long
* * Dim wksto As Worksheet

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to
copy", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * For i = 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

* * Application.CutCopyMode = False

End Sub

Steve,

See if this will do the trick for you.

Best,

Matt

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("Selectdata 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