XL 2013 VBA erreur d'exécution export vers Access

Private Sub TRANSPOSEACCESS()

On Error GoTo myEnd
    ' exports data from the active worksheet to a table in an Access database this procedure must be edited before use
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=C:\Users\Emilie\Desktop\DANWARE.accdb;Persist Security Info=False;"

    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "T_POSE", cn, adOpenKeyset, adLockOptimistic, adCmdTable

    ' all records in a table

    r = 2 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0

    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("Chantier") = Range("A" & r).Value
            .Fields("Zone") = Range("B" & r).Value
            .Fields("Prestation") = Range("C" & r).Value
            .Fields("Unite") = Range("D" & r).Value
            .Fields("Qte") = Range("E" & r).Value
            .Fields("PU") = Range("F" & r).Value
            .Fields("TotalNet") = Range("G" & r).Value
            .Fields("Qui") = Range("H" & r).Value
            .Fields("Type") = Range("I" & r).Value
            .Fields("Avct") = Range("J" & r).Value
            .Fields("DatePose") = Range("K" & r).Value
            .Fields("QteAvct") = Range("L" & r).Value
            .Fields("MontantAvctNet") = Range("M" & r).Value
            .Fields("Notes") = Range("N" & r).Value
            .Fields("QteBase") = Range("O" & r).Value
            .Fields("FactureST") = Range("P" & r).Value
            .Fields("DateFactureST") = Range("Q" & r).Value
            .Fields("NumFactureST") = Range("R" & r).Value
            .Fields("XLSBDID") = Range("S" & r).Value
            ' .Fields("DevisDetailID") = Range("H" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record


        End With
        r = r + 1 ' next row
    Loop
On Error Resume Next

    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

myEnd:

Sheets("EXPORT").Select
Dim cnx As ADODB.Connection, rsx As ADODB.Recordset, rx As Long
Dim cd As New ADODB.Command

' connect to the Access database
Set cnx = New ADODB.Connection
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=C:\Users\Emilie\Desktop\DANWARE.accdb;Persist Security Info=False;"

' open a recordset
Set rsx = New ADODB.Recordset
rsx.Open "T_POSE", cnx, adOpenKeyset, adLockOptimistic, adCmdTable
cd.ActiveConnection = cnx
   
    rx = 2 ' the start row in the worksheet
    Do While Len(Range("A" & rx).Formula) > 0

    ' repeat until firsxt empty cell in column A
        With rsx
        cd.CommandText = "UPDATE [T_POSE] SET [Chantier] = '" & Range("A" & rx).Value & "',[Zone] = '" & Range("B" & rx).Value & "',[Prestation] = '" & Range("C" & rx).Value & "',[Unite] = '" & Range("D" & rx).Value & "',[Qte] = '" & Range("E" & rx).Value & "',[PU] = '" & Range("F" & rx).Value & "',[TotalNet] = '" & Range("G" & rx).Value & "',[Qui] = '" & Range("H" & rx).Value & "',[Type] = '" & Range("I" & rx).Value & "',[Avct] = '" & Range("J" & rx).Value & "',[DatePose] = '" & Range("K" & rx).Value & "', [QteAvct] = '" & Range("L" & rx).Value & "',[MontantAvctNet] = '" & Range("M" & rx).Value & "',[Notes] = '" & Range("N" & rx).Value & "',[QteBase] = '" & Range("O" & rx).Value & "',[FactureST] = '" & Range("P" & rx).Value & "',[DateFactureST] = '" & Range("Q" & rx).Value & "',[NumFactureST] = '" & Range("R" & rx).Value & "',[XLSBDID] = '" & Range("Q" & rx).Value & "' WHERE [XLSBDID] = '" & Range("S" & rx).Value & "'"
        cd.Execute
'              MsgBox (cd.CommandText) 'debug
         End With
        rx = rx + 1 ' next row
    Loop
     rsx.Close
     Set rsx = Nothing
     cnx.Close
     Set cnx = Nothing

End Sub