Copy the CurrentRegion of a cell

[Maheshp]

I have to find ABC string within cell in column A & if found then want to select entire region of cell & copy on another sheet ("Test")
below code should copy only two Region for ABC but it copy them on multiple times don’t know why
I will appreciate any help on this

<TABLE style="WIDTH: 92pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=122><COLGROUP><COL style="WIDTH: 49pt; mso-width-source: userset; mso-width-alt: 2377" width=65><COL style="WIDTH: 43pt; mso-width-source: userset; mso-width-alt: 2084" width=57><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 49pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20 width=65>ABC</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 43pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 width=57>XYZ</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 height=20 align=right>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 align=right>11</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 height=20 align=right>4</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 align=right>12</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>ABC T</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64>XYZ</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 height=20 align=right>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 align=right>11</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 height=20 align=right>4</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl64 align=right>12</TD></TR></TBODY></TABLE>

Sub test()
Dim LR As Long, i As Long
Dim found, Rng As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If InStr(Range("A" & i).Value, "ABC") Then Rows(i).CurrentRegion.Select
Selection.Copy Destination:=Sheets("Test").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub

 

[VoG]

Hi. As long as there are blank rows above and below each set of data then this works for me

Sub test()
Dim LR As Long, i As Long
Dim found, Rng As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
    If InStr(Range("A" & i).Value, "ABC") Then Range("A" & i).CurrentRegion.Copy Destination:=Sheets("Test").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub

 

[Maheshp]

Brilliant !

Thank u so much VoG.