Input box copying the wrong rows

[Steve]

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

 

[JLGWhiz]

Try changing this:

For i = 0 To lngRangeCount

To:

For i = 1 To lngRangeCount

 

[Steve]

I tried it, but now it only copies 1 row (10 times).
I selected rows 10 & 20 as a test, but only row 10 got copied and the
procedure ended.

 

[JLGWhiz]

Steve, I am getting some weird results also. I am tired tonight, but I will
look at it again tomorrow and see if I can figure out what is happening.

 

[JLGWhiz]

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]

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

 

[JLGWhiz]

I don't understand that, I tested the macro and it gave me two copied rows
pasted ten times each. How about copying the code you tried last and let me
see what the difference is between that and the code that worked for me.

 

[JLGWhiz]

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]

Alright this is weird. I copy & pasted the code you supplied above,
and when I ran the procedure, and selected rows 10 & 20 to copy ten
times each, it originally only copy and pasted row 10, twenty times.
When I comment out:

Application.CutCopyMode = False

The procedure copied row 10 ten times, and then row 20 ten times, as
it should. I don't get it.

Thanks for the help JLG...

 

[Steve]

Solved!
It's not Application.CutCopyMode = False. It's if I am in a different
sheet when I run the procedure. If I am, and I then I select the sheet
to copy from, nothing gets copied.
If I start the procedure while I am in the sheet I need to copy from,
it works fine. My fault.

Thanks for the help...