XL 2019 Problème avec le code VBA sur un PC

Sub RecupBaseMois()
Application.ScreenUpdating = False
    Dim objField As ADODB.Field
    Dim rsData As ADODB.Recordset
    Dim lOffset As Long
    Dim szConnect As String
    Dim szSQL As String
    Dim j As Integer
    Dim y As Long
    Dim i As Long
 
    Chemin = ActiveWorkbook.Path
 
    i = Sheets("Param").Range("B2")
 
    If Sheets("Bordereau").Range("A2") = 0 Then
        If Sheets("Basemois").Cells(2, 1) = "" Then
            Sheets("Bordereau").Range("A1") = CDate(Sheets("Bdn").Cells(i, 2)) + 2
        Else
            Dim l As Integer
            l = Sheets("Param").Range("AM35") + 1
            Sheets("Bordereau").Range("A1") = CDate(Sheets("BaseMois").Cells(l, 1) + 1)
        End If
    End If
     
        Sheets("BaseMois").Range("A1:BH32").ClearContents
        j = Month(Sheets("Bordereau").Range("A2"))
        y = Year(Sheets("Bordereau").Range("A2"))
   
        szConnect = "Provider=Microsoft.jet.OLEDB.4.0;" & _
        "Data Source=" & Chemin & "\" & Base & ";" & _
        "Mode-Share Exclusive"
     
        szSQL = "select * from Datas where month(datejour)=" & j & " and year(datejour)=" & y
     
        If Not FileExists(Base) Then
            MsgBox "Le fichier Base est introuvable !", vbCritical, "Erreur critique"
            GoTo ErrorExit
        End If
     
        Set rsData = New ADODB.Recordset
       rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
     
        If Not rsData.EOF Then
            With Sheets("BaseMois").Range("A1")
                For Each objField In rsData.Fields
                    .Offset(0, lOffset).Value = objField.Name
                    lOffset = lOffset + 1
                Next objField
                .Resize(1, rsData.Fields.Count).Font.Bold = True
            End With
            Sheets("BaseMois").Range("A2").CopyFromRecordset rsData
            Sheets("BaseMois").UsedRange.EntireColumn.AutoFit
        Else
            GoTo ErrorExit
        End If
     
ErrorExit:
        rsData.Close
        Set rsData = Nothing
     
Application.ScreenUpdating = True
End Sub

rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText

Sub Insert()
Application.ScreenUpdating = False

    '------------Déclarations des variables------------------
    Dim DateJour As Long, Restaurant As Double, Bar As Double, Couverts As Integer, Offerts As Integer
    etc...
    
    
    
    chemin = ActiveWorkbook.Path
    
    
    Dim objCommand As ADODB.Command
    Dim rsData As ADODB.Recordset
    Dim lRecordsAffected As Long
    Dim szConnect As String
    
    On Error GoTo ErrorHandler
      
      
        Sheets("DonneesBordereau").Select
        Sheets("DonneesBordereau").Cells(2, 1).Select
        DateJour = ActiveCell
        Restaurant = ActiveCell.Offset(0, 1)
        etc...
      
        szConnect = "Provider=Microsoft.jet.OLEDB.4.0;" & _
        "Data Source=" & chemin & "\" & Base & ";" & _
        "Mode-Share Exclusive"
        
        If Not FileExists(Base) Then
            MsgBox "Le fichier Base.mdb est introuvable !", vbCritical, "Erreur critique !"
            GoTo ErrorExit
        End If
        
        Set objCommand = New ADODB.Command
        objCommand.ActiveConnection = szConnect
    
        
        objCommand.CommandText = "INSERT INTO Datas(DateJour,Restaurant,Bar,Couverts,Offerts,Cinema,BarMAS,Cigarettes,Animation" & _
        ",Boule,PbBoule,EntreesBoule,Roulette,PbRoulette,BJ,PbBJ,EntreesJeux,CSG,MAS,PbMAS,EntreesMAS,Orph,Erreurs,DropMAS,DropRoulette,DropBoule" & _
        ",Comptee,H,F,Glaces,ChqMAS,CBMAS,ChqJeux,CBJeux,Positifs,Negatifs,BouleFerme,JeuxFerme,OrphJeux,OrphBoule,Location,Billeterie,ChequesBar,CBBar" & _
        ",ChequesResto,CBResto,TicketsResto,OffertsResto,OffertsBar,OffertsBarMAS,Banquet, PMU, PMU_Paris, TITOfin, TITOdebut, Coupons, fdj, ErreursGJ" & _
        ", RAE, Forfaits_MAS, TITOSexp, PbRAE, BJE)" & _
        "VALUES(" & DateJour & "," & Restaurant & "," & Bar & "," & Couverts & "," & Offerts & "," & Cinema & _
        "," & BarMAS & "," & Cigarettes & "," & Animation & "," & Boule & "," & PbBoule & "," & EntreesBoule & _
        "," & Roulette & "," & PbRoulette & "," & BJ & "," & PbBJ & "," & EntreesJeux & "," & CSG & "," & MAS & _
        "," & pbMAS & "," & EntreesMAS & "," & Orph & "," & Erreurs & "," & DropMAS & "," & DropRoulette & "," & _
        DropBoule & "," & Comptee & "," & H & "," & F & "," & Glaces & "," & ChqMAS & "," & CBMAS & "," & ChqJeux & "," & _
        CBJeux & "," & Positifs & "," & Negatifs & "," & BouleFerme & "," & JeuxFerme & "," & OrphJeux & "," & OrphBoule & "," & Location & "," & _
        Billeterie & "," & ChequesBar & "," & CBBar & "," & ChequesResto & "," & CBResto & "," & TicketsResto & "," & OffertsResto & "," & _
        OffertsBar & "," & OffertsBarMAS & "," & Banquet & "," & PMU & "," & PMU_Paris & "," & titofin & "," & TITOdebut & "," & coupons & "," & _
        FDJ & "," & ErreursGJ & "," & RAE & "," & Forfaits_MAS & "," & TITOSexp & "," & PbRAE & "," & BJE & ");"
    
        objCommand.Execute RecordsAffected:=lRecordsAffected, Options:=adCmdText
        PasErreur = 1
    
    If lRecordsAffected <> 1 Then Err.Raise Number:=vbObjectError + 1024, Description:="Erreur d'execution de l'instruction INSERT."
    
ErrorExit:
    Set objCommand = Nothing
    Set rsData = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ErrorExit
Application.ScreenUpdating = True
End Sub