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

--
Message posted from http://www.ExcelForum.com