Fonction ADODB = problème

Sub Fermer_et_sauvegarder()

'Transfert vers fichier base
'Call Transfert_base
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String
Dim VSearch As String, i As Integer

' Chemin d'accès de la base
Fichier = ThisWorkbook.Path & "\base.xls"
' Créer la connexion
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
' Ouvrir 1000 lignes d'enegistrement
Cd.CommandText = "SELECT * FROM [Feuil1$A1:Z1000]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
' Chercher la valeur dans la BdD
Rst.Find "F1 = '" & Range("G9") & "'", , adSearchForward, 1
' Si on se retrouve à la fin des enregistrement
' On en créé un nouveau
If Rst.EOF = True Then Rst.AddNew
' On rempli la ligne d'enregistrement avec les valeurs
For i = 0 To 25 ' Mettre ici le nombre de champs -1
Rst(i).Value = Sheets("Transfert").Cells(1, 1 + i)
Next i
' Metre à jour la ligne d'enregistrement
Rst.Update
' Fermer la connexion
Cn.Close
' Effacer les variables objet
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing


'sauvegarder
ActiveWorkbook.Save

'fermer
Autoriser_Fermeture = True
ActiveWorkbook.Close

End Sub