Macro to copy text from ColumnA to B

S

Sarah

Need a macro to copy all rows with the text "sh cam" from
column A to column B.
This is an example only shows 3 examples but my excel
spreadsheet has over 2000.

Column A

Jim Glover
sh cam 00-08-74-34-48
Tammy Smith
sh cam 00-75-38-d9-39
Sam Dover
sh cam 00-08-28-23-23

Thanks
Sarah
 
C

chuck

Sub Move_A_to_B()
For MyRow = 1 To 2000 ' change 2000 to your last row
MyValue = Range("a" & MyRow).Value
If Left(MyValue, 6) = "sh cam" Then
Range("b" & MyRow).Value = "sh cam"
Range("a" & MyRow).ClearContents
End If
Next MyRow
End Sub
 
T

Tom Ogilvy

Dim rng as Range, rng1 as Range
Dim sForm as String

columns(2).Insert
set rng = Range(cells(1,1),cells(rows.count,1).End(xlup))
sForm = "=IF(ISERROR(SEARCH(""sh cam"",A1)),"""",NA())"

rng.offset(0,1).Formla = sForm
on Error Resume Next
set rng1 = rng.offset(0,1).SpecialCells(xlFormulas,xlErrors)
set rng1 = Intersect(Columns(1),rng1.EntireRow)
On Error goto 0
columns(2).Delete
if not rng1 is nothing then
rng1.EntireRow.copy Destination:= _
worksheets("sheet2").Range("A1")
End if
 
S

SARAH

THANKS ALOT!!!!!!!!!!!!!!!!!!!!!!!!!
WORKS PERFECT
-----Original Message-----
Dim rng as Range, rng1 as Range
Dim sForm as String

columns(2).Insert
set rng = Range(cells(1,1),cells(rows.count,1).End(xlup))
sForm = "=IF(ISERROR(SEARCH(""sh cam"",A1)),"""",NA())"

rng.offset(0,1).Formla = sForm
on Error Resume Next
set rng1 = rng.offset(0,1).SpecialCells (xlFormulas,xlErrors)
set rng1 = Intersect(Columns(1),rng1.EntireRow)
On Error goto 0
columns(2).Delete
if not rng1 is nothing then
rng1.EntireRow.copy Destination:= _
worksheets("sheet2").Range("A1")
End if

--
Regards,
Tom Ogilvy





.
Click to expand...
 
Top