Background:

I have raw data in the form of a Job List, this is where the code is written

The code below is quite close to what I want, however:

'2) If Cell equals Team CB's Client then line is copied to appropriate
w/sheet:
the line is copied over 3 times

'4)If Cell equals Team MS's Client then line is copied to appropriate w/sheet:
the line isn't copied over at all

Many Thanks

Public Sub coi()
Dim fin As Workbook
Dim fin2 As Workbook
Dim vArr As Variant
Dim vArr2 As Variant
Dim rCell As Range
Dim rDest As Range
Dim sDest As Range
Dim i As Long
Dim j As Long

'1)Opens Team CB and Team MS Workbooks,define arrays in line with
Client Lists
Set fin = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamCB.xls")
Set fin2 = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamMS.xls")
vArr = Array("Hudson", "HSB", "C&W")
vArr2 = Array("ACCENT", "AMEX", "SHELL")


For Each rCell In Range("D1:D" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vArr) To UBound(vArr)
For j = LBound(vArr2) To UBound(vArr2)
'2) If Cell equals Team CB's Client then line is copied to
appropriate w/sheet
If .Value = vArr(i) Then
Set rDest = fin.Worksheets(vArr(i)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=rDest
'3) If Client is not designated Client but Executive is CB copies
to "Other"
ElseIf .Offset(0, 3).Value = "CB" Then
..EntireRow.Copy _
Destination:=fin.Worksheets("OTHER").Cells(25,
1).End(xlUp).Offset(1, 0)

'4)If Cell equals Team MS's Client then line is copied to
appropriate w/sheet
If .Value = vArr2(j) Then
Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=sDest
Exit For

End If
End If
Next j
Next i
End With
Next rCell
End Sub