Macro to select rows based on cell criteria

[evamarie]

I have an Excel spreadsheet which needs to be formatted so it cuts certain rows from sheet 1, based on a specific condition, pastes them into sheet 2, and then deletes the subsequently new blank rows on sheet 1.

Sheet 1 is named "CP"
Sheet 2 is named "CO, MR, PO, PP"

What I need to do is have the macro cut all the rows which have "CO" in column B moved to Sheet 2.

Here's the code I've got so far, which is not working

Sub MacroCellsCO()

ActiveSheet.Select
Dim rngA As Range
Dim cell As Range
Set rngA = Range("B1", Range("B65536"))
For Each cell In rngA
If cell.Value = "CO" Then
cell.EntireRow.Copy
Sheets("CO, MR, PO, PP").Range("A1:A65536").End(x1up).Offset(1, 0).Select
ActiveSheet.Paste
Sheets("CP").Select
Selection.Delete Shift:=xlUp
End If
Next cell

End Sub

I'm definitely not a programmer, but my boss needs this to work, so any help would be greatly appreciated!

Thanks,
Eva Marie

 

[texasalynn]

try this

Sub MoveCO_data()
Dim LR As Long, ALR As Long
Dim MSht As String, DSht As String
MSht = "CP"
DSht = "CO, MR, PO, PP"
Sheets(MSht).Activate
LR = Sheets(MSht).Range("B" & Rows.Count).End(xlUp).Row
ALR = Sheets(DSht).Range("B" & Rows.Count).End(xlUp).Row + 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'filter for dropout data
    Cells.AutoFilter
    Cells.AutoFilter Field:=2, Criteria1:="CO"
    Range("A2:G" & LR).SpecialCells(xlCellTypeVisible).Select
    Range("A2:G" & LR).Copy
    Sheets(DSht).Activate
    Cells(ALR, 1).Activate
    ActiveSheet.Paste
    Sheets(MSht).Activate
    Cells.AutoFilter
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub