S
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
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