Sabotage
Board Regular
- Joined
- Sep 19, 2013
- Messages
- 58
Hi All,
The following code is collecting information from one sheet and pastes it into another one. The problem occurs when the code is finding the rows with a certain criteria. The highlighted part is where the code is selecting all the rows from the first row with the desired data in it. The code works fine as it shown below until there is only one row with the desired data. Because if there are more rows with the desired data in it, it will select all them rows. If only one row is available the selection ends at the last row of the sheet. In the red line I need something to select the first row with the data and the last one if there are more then one. Then copy and paste into the next sheet.
I have tried to replace the xlDown with different things and this is the part where I'm stuck. Even if something simple like "Activerow + 100" would help I just cant make this work. Hope this was clear enough. Please if you have any good ideas how to crack this let me know. Many thanks in advance.
Code:
WB.Worksheets("X").Select
Dim SrchRng1 As Range
Dim a1 As Range, f As String
Set SrchRng1 = ActiveSheet.Range("a1", ActiveSheet.Range("D1000").End(xlUp))
Set a1 = SrchRng1.Find("Yes", LookIn:=xlValues)
If Not a1 Is Nothing Then
f = a1.Address
With ActiveSheet.Range("A" & a1.Row & ":K" & a1.Row)
.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Hub").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Hub").Range("A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End If
Regards,
Alex
The following code is collecting information from one sheet and pastes it into another one. The problem occurs when the code is finding the rows with a certain criteria. The highlighted part is where the code is selecting all the rows from the first row with the desired data in it. The code works fine as it shown below until there is only one row with the desired data. Because if there are more rows with the desired data in it, it will select all them rows. If only one row is available the selection ends at the last row of the sheet. In the red line I need something to select the first row with the data and the last one if there are more then one. Then copy and paste into the next sheet.
I have tried to replace the xlDown with different things and this is the part where I'm stuck. Even if something simple like "Activerow + 100" would help I just cant make this work. Hope this was clear enough. Please if you have any good ideas how to crack this let me know. Many thanks in advance.
Code:
WB.Worksheets("X").Select
Dim SrchRng1 As Range
Dim a1 As Range, f As String
Set SrchRng1 = ActiveSheet.Range("a1", ActiveSheet.Range("D1000").End(xlUp))
Set a1 = SrchRng1.Find("Yes", LookIn:=xlValues)
If Not a1 Is Nothing Then
f = a1.Address
With ActiveSheet.Range("A" & a1.Row & ":K" & a1.Row)
.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Hub").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Hub").Range("A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End If
Regards,
Alex