Copie Feuille par Méthode "ADO" Ok! Mais une cellule Manque... Incompréhensible!!!

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("ABONNES").Select
ActiveSheet.UsedRange.Select
Dim CELLULE As Range
For Each CELLULE In Selection
  If Left(CELLULE, 1) <> "¥" Then
     CELLULE = "¥" & CELLULE
  End If
Next
ActiveWorkbook.Save
End Sub

Sub ENREGISTRER()
'(A ne pas oublier de cocher "Microsoft ADO Ext. 2.7 for DDL and Sécurity dans les Références)
Dim Cn As ADODB.Connection
    Dim Cd As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String
        Fichier = ThisWorkbook.Path & "\DONNEES_2.xls"
    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
    Cd.CommandText = "SELECT * FROM [Feuil1$A1:A1]"

    Set Rst = New ADODB.Recordset
    Rst.Open Cd, , adOpenKeyset, adLockOptimistic
    Rst(0).Value = "¥" & UserForm1.TextBox1.Text
    Rst.Update
    
    Cn.Close
    Set Cn = Nothing
    Set Cd = Nothing
    Set Rst = Nothing
End Sub

Sub TRANSFERER_VERS_BASE_DE_DONNEES() 'La référence "Microsoft ActiveX Data Object 2.x Library" doit être cochée!
Dim APPEL As New ADODB.Connection
Dim ENREGISTREMENT As New ADODB.Recordset, FEUILLE As ADODB.Recordset
Dim ECOUTE As ADODB.Connection, j As Integer
Dim CLASSEUR_CIBLE As String, CLASSEUR_SOURCE As String
CLASSEUR_CIBLE = ThisWorkbook.Path & "\BASE.xls" 'On pourrait remplacer par une Recherche du Classeur!
CLASSEUR_SOURCE = ActiveWorkbook.FullName
'------------------------------------------------------------------
APPEL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CLASSEUR_SOURCE & ";" & "Extended Properties=""Excel 8.0;HDR=NO;"""
ENREGISTREMENT.Open "SELECT * FROM [TRANSFERT$]", APPEL, adOpenStatic 'FEUILLE A POMPER
 '------------------------------------------------------------------
Set ECOUTE = New ADODB.Connection
 ECOUTE.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
 "Data Source=" & CLASSEUR_CIBLE & ";" & "Extended Properties=""Excel 8.0;HDR=NO;"""
Set FEUILLE = New ADODB.Recordset
FEUILLE.Open "Select * from [RECEPTION$]", ECOUTE, adOpenKeyset, adLockOptimistic ' FEUILLE DE DESTINATION
'------------------------------------------------------------------
Do While Not (ENREGISTREMENT.EOF) 'ON PROCEDE A L'ECRITURE
    FEUILLE.AddNew
        For j = 0 To FEUILLE.Fields.Count - 1
        FEUILLE.Fields(j) = ENREGISTREMENT.Fields(j).Value
        Next j
    FEUILLE.Update
  ENREGISTREMENT.MoveNext
Loop
ENREGISTREMENT.Close: APPEL.Close: FEUILLE.Close: ECOUTE.Close
End Sub

Do While Not (ENREGISTREMENT.EOF) 'ON PROCEDE A L'ECRITURE
    FEUILLE.AddNew
        For j = 0 To FEUILLE.Fields.Count - 1
        FEUILLE.Fields(j) = ENREGISTREMENT.Fields(j).Value
        Next j
    FEUILLE.Update
  ENREGISTREMENT.MoveNext
Loop

        With CONNEXION
          .Provider = "Microsoft.Jet.OLEDB.4.0"
          .ConnectionString = "Data Source=" & CLASSEUR_A_FOUILLER & ";Extended Properties=""Excel 8.0;IMEX=1"""
          .Open
        End With