InputBox doesn't allow non adjacent rows
On Mar 5, 11:14*am, Steve wrote:
I have the below procedure which allows me to select a 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 to select
multiple rows 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("Select data 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("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
|