Conditional CCP entire row
 

Hi All........
If someone would be so kind, I would like to interrogate Column F of sheet1
and for every value that begins with MISC, to Copy and Paste that entire row
over to Sheet2 (adding it to the bottom of the database there), and then
deleting that row from sheet1. Somehow my recorder just cant get there from
here..........

TIA
Vaya con Dios,
Chuck, CABGx3

Conditional CCP entire row
 

Sub MoveData()
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim sAddr As String
With Worksheets("Source")
Set rng = .Columns(6).Find("MISC*", _
After:=.Range("F65536"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
If rng1 Is Nothing Then
Set rng1 = rng
Else
Set rng1 = Union(rng, rng1)
End If
Set rng = .Columns(6).FindNext(rng)
Loop Until rng.Address = sAddr
Set rng2 = Worksheets("Destination" _
).Cells(Rows.Count, 1).End(xlUp)(2)
rng1.EntireRow.Copy rng2
rng1.EntireRow.Delete
End If
End With

End Sub

Change sheet names to reflect yours.

--
Regards,
Tom Ogilvy

"CLR" wrote:

Hi All........
If someone would be so kind, I would like to interrogate Column F of sheet1
and for every value that begins with MISC, to Copy and Paste that entire row
over to Sheet2 (adding it to the bottom of the database there), and then
deleting that row from sheet1. Somehow my recorder just cant get there from
here..........

TIA
Vaya con Dios,
Chuck, CABGx3

Conditional CCP entire row
 

That is INSTANTLY COOL Tom..........many many thanks. It does exactly as I
need.

Vaya con Dios,
Chuck, CABGx3



"Tom Ogilvy" wrote:

Sub MoveData()
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim sAddr As String
With Worksheets("Source")
Set rng = .Columns(6).Find("MISC*", _
After:=.Range("F65536"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
If rng1 Is Nothing Then
Set rng1 = rng
Else
Set rng1 = Union(rng, rng1)
End If
Set rng = .Columns(6).FindNext(rng)
Loop Until rng.Address = sAddr
Set rng2 = Worksheets("Destination" _
).Cells(Rows.Count, 1).End(xlUp)(2)
rng1.EntireRow.Copy rng2
rng1.EntireRow.Delete
End If
End With

End Sub

Change sheet names to reflect yours.

--
Regards,
Tom Ogilvy

"CLR" wrote:

Hi All........
If someone would be so kind, I would like to interrogate Column F of sheet1
and for every value that begins with MISC, to Copy and Paste that entire row
over to Sheet2 (adding it to the bottom of the database there), and then
deleting that row from sheet1. Somehow my recorder just cant get there from
here..........

TIA
Vaya con Dios,
Chuck, CABGx3