T
teresa
Hi, Im having problems at the 'Else If' line, help is much appreciated, Teresa
Public Sub coiD()
Dim fin As Workbook
Dim vArr As Variant
Dim rCell As Range
Dim rDest As Range
Dim i As Long
Set fin = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\Team.xls")
vArr = Array("Hudson", "John", "Jim")
For Each rCell In Range("D1" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vArr) To UBound(vArr)
If .Value = vArr(i) Then
Set rDest = fin.Worksheets(vArr(i)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
'If rDest.Row < 18 Then _
' Set rDest = rDest.Offset(18 - rDest.Row, 0)
.EntireRow.Copy Destination:=rDest
Else If rCell.Offset(0,3)= "CC" Then
rCell.EntireRow.Copy
Destination:=fin.Worksheets("Other").Cells( _
25, 1).End(xlUp).Offset(1, 0)
Exit For
End If
Next i
End With
Next rCell
Public Sub coiD()
Dim fin As Workbook
Dim vArr As Variant
Dim rCell As Range
Dim rDest As Range
Dim i As Long
Set fin = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\Team.xls")
vArr = Array("Hudson", "John", "Jim")
For Each rCell In Range("D1" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vArr) To UBound(vArr)
If .Value = vArr(i) Then
Set rDest = fin.Worksheets(vArr(i)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
'If rDest.Row < 18 Then _
' Set rDest = rDest.Offset(18 - rDest.Row, 0)
.EntireRow.Copy Destination:=rDest
Else If rCell.Offset(0,3)= "CC" Then
rCell.EntireRow.Copy
Destination:=fin.Worksheets("Other").Cells( _
25, 1).End(xlUp).Offset(1, 0)
Exit For
End If
Next i
End With
Next rCell