Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
InputBox doesn't allow non adjacent rows
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
InputBox doesn't allow non adjacent rows
To loop through all the areas selected, try the following:
Sub test() Dim rngCell As Range Dim rngAreas As Areas Dim rngArea As Range Set rngAreas = Selection.Areas For Each rngArea In rngAreas For Each rngCell In rngArea rngCell = rngCell.Address Next Next End Sub PA " wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
InputBox doesn't allow non adjacent rows
Thanks Bill.
However; this copies the wrong rows. If I select rows 10 & 20, it copies 9 &10. On Mar 5, 11:40*am, wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
InputBox doesn't allow non adjacent rows
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
InputBox doesn't allow non adjacent rows
On Mar 5, 3:33*pm, Steve wrote:
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 I simply wrote the code rather than actually testing it; my mistake for the error. The "myRange." in the second For Loop should be replaced with "rngLoopRange.". See below. Matt For j = 1 To rngLoopRange.Rows.Count rngLoopRange.Rows(i).EntireRow.Copy wksto.Cells (wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10, wksto.Columns.Count) Next |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Add cells on two adjacent rows but non-adjacent columns | Excel Worksheet Functions | |||
Copy non adjacent rows | Excel Discussion (Misc queries) | |||
Compare adjacent fields in adjacent rows | New Users to Excel | |||
Countif on non adjacent rows | Excel Programming | |||
Selecting non-adjacent rows | Excel Programming |