Visual Basic para Aplicaciones - error metodo excel.worksheet

Dim doc As Excel.Application

Dim fila As Integer

Dim columna As Integer

Dim ind As Integer

   Set doc = New Excel.Application

   doc.Workbooks.Open RutaArchivo & NombreArchivo

   With doc.Sheets(ind)

      .cells(fila, columna).value = valor

      .....

      .....

   End With

   doc.ActiveWorkbook.Save

   doc.ActiveWorkbook.Close

  Set doc = Nothing

Call AbreCost 'abre bd

Dim RsEXC As ADODB.Recordset

Dim Consult As String

Dim Excell As Object

Dim Folla As Object

Dim Libro As Object

Consult = "Z:\2012-001  AIRPORT\4 FINANCIAL PLANNING\42 SUPPLIERS\MODELO FACTURA1.xlsx"

Set RsEXC = New ADODB.Recordset

Set Excell = CreateObject("Excel.application")

Excell.Workbooks.Open (Consult), False, False

Set Libro = Excel.Workbooks.Application

Set Folla = Libro.Worksheets("1. Contract")

'Set RsName = New ADODB.Recordset

'RsName.Open "select Distinct Subname From ConsBQ where ContRef = '" & DataCombo1.Text & "' and  SubName = '" & SubCon & "' and CompRef = '" & DataCombo6.Text & "'", ConnCost, adOpenDynamic

With Excell

.'Application.Libro.Activate    'daba error y lo anule con comilla

.Worksheets("1. CONTRACT").Activate

End With

RsEXC.Open "select Subname,Contworks From ConsBQ where ContRef = '" & DataCombo1.Text & "' and  SubName = '" & SubCon & "' and CompRef = '" & DataCombo6.Text & "'", ConnCost, adOpenDynamic

RsEXC.MoveLast

RsEXC.MoveFirst

ActiveSheet.Range("C7").Select

Sheets("1. CONTRACT").Cells("C7").Value = RsEXC("Subname")  'AQUI TAMBIEN DA ERROR DICIENDO QUE NO ADMITE ESTE METODO

ActiveSheet.Range("C8").Select

Sheets("1. CONTRACT").Cells("C8").Value = RsEXC("Contworks")

Excell.ActiveWorkbook.Save

Excell.Application.Quit

Set Excell = Nothing

Set RsEXC = Nothing

End Sub