Hi,

Rather than repeating the below 18 times how do I make this more efficient,
many thanks for help

Teresa


Sub coi()
Set fin = Application.Workbooks.Open("C:\My Documents\Business
Plans\Team.xls")

lastrow = Cells(Rows.Count, 3).End(xlUp).Row
j = 18
For i = 3 To lastrow
If Cells(i, 4) = "Hudson" Then
Cells(i, 4).EntireRow.Copy Destination:=fin.Worksheets("Hudson").Cells(j, 1)
j = j + 1
End If
Next

j = 18
For i = 3 To lastrow
If Cells(i, 4) = "John" Then
Cells(i, 4).EntireRow.Copy Destination:=fin.Worksheets("John").Cells(j, 1)
j = j + 1
End If
Next

End Sub