Help with find then copy macro

[john_t_h]

I am trying to get the code below to check through column Q of a
worksheet, when it finds a value that is in the case statement I want
to copy the entire row over to another worksheet.

So I'm trying to do this

Code:
--------------------
in worksheet "manning" check each cell in column Q
if cell = "actual"
then copy row to worksheet "actual"
if cell = "substantive"
then copy row to worksheet "substantive"
--------------------


At the moment it is not copying any data across.




Code:
--------------------
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Dim Ws1Q As Range

Dim ActualVacRow As Long
Dim SubstantiveVacRow As Long

Dim Cell1 As Range

Set Ws1 = Workbooks("manning.xls").Sheets("manning")
Set Ws2 = Workbooks("manning.xls").Sheets("Actual")
Set Ws3 = Workbooks("manning.xls").Sheets("Substantive")

Set Ws1Q = Ws1.Columns("Q")

For Each Cell1 In Ws1.Range("Q1:q" & Range("q65536").End(xlUp).Row)
Select Case UCase(C)
Case "ACTUAL": ActualVacRow = Ws2.Range("a65536").End(xlUp).Row + 1
Ws1.Rows(Cell1.Row).Copy Destination:=Ws2.Rows(ActualVacRow)
Case "SUBSTANTIVE": SubstantiveVacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws1.Rows(Cell1.Row).Copy Destination:=Ws3.Rows(SubstantiveVacRow)
End Select
Next Cell1

 

[Kieran]

try ,

Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Dim Ws1Q As Range

Dim ActualVacRow As Long
Dim SubstantiveVacRow As Long

Dim Cell1 As Range

Set Ws1 = Workbooks("manning.xls").Sheets("manning")
Set Ws2 = Workbooks("manning.xls").Sheets("Actual")
Set Ws3 = Workbooks("manning.xls").Sheets("Substantive")

Set Ws1Q = Ws1.Columns("Q")

For Each Cell1 In Ws1.Range("Q1:q"
Range("q65536").End(xlUp).Row)
Select Case UCase(Cell1.Value)
Case "ACTUAL"
ActualVacRow = Ws2.Range("a65536").End(xlUp).Row + 1
Ws1.Rows(Cell1.Row).Cop
Destination:=Ws2.Rows(ActualVacRow)
Case "SUBSTANTIVE"
SubstantiveVacRow = Ws3.Range("a65536").End(xlUp).Row
1
Ws1.Rows(Cell1.Row).Cop
Destination:=Ws3.Rows(SubstantiveVacRow)
Case Else
MsgBox Cell1.Value & " is unexpected"
End Select
Next Cell

 

[john_t_h]

I gave it a go and I got the case else msg box straight up. I am
thinking it might have borked at the heading in column Q.

So I took out the case else and still nothing is copied across.

 

[Kieran]

john_t_h,

After the heading was shown in the message box, did you get any further
messages displayed?
I am thinking that there may be trailing spaces etc in the text Actual,
substantive so try the following.
I ahve amended the range to exclude Q1 so the heading messge should not
appear.


Sub test()


Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Dim Ws1Q As Range

Dim ActualVacRow As Long
Dim SubstantiveVacRow As Long

Dim Cell1 As Range

Set Ws1 = Workbooks("manning.xls").Sheets("manning")
Set Ws2 = Workbooks("manning.xls").Sheets("Actual")
Set Ws3 = Workbooks("manning.xls").Sheets("Substantive")

Set Ws1Q = Ws1.Columns("Q")

For Each Cell1 In Ws1.Range("Q2:q" &
Range("q65536").End(xlUp).Row)
Select Case Trim(UCase(Cell1.Value))
Case "ACTUAL"
ActualVacRow = Ws2.Range("a65536").End(xlUp).Row + 1
Cell1.EntireRow.Copy
Destination:=Ws2.Rows(ActualVacRow)
Case "SUBSTANTIVE"
SubstantiveVacRow = Ws3.Range("a65536").End(xlUp).Row +
1
Cell1.EntireRow.Copy
Destination:=Ws3.Rows(SubstantiveVacRow)
Case Else
MsgBox Cell1.Value & " is unexpected"
End Select
Next Cell1
End Sub

 

[acw]

try replacing the line
Select Case UCase(C)

to

Select Case UCase(Cell1)

Tony

 

[john_t_h]

That did the trick thanks