Ecrire dans une base acces impossible

Makina

XLDnaute Junior
Bonjour,

Je souhaite inserer des données provenant d un excel dans une base de données access, mais cela ne fonctionne pas. Ma macro se déroule mais rien ne s écrit . Pouvez vous corriger mon sub ? Merci d avance à tous.

Code:
Sub intégrer_dans_base()

Dim m As Integer
Dim n As Integer
Dim A As String
Dim b As String
Dim c As String
Dim p As Integer


m = 4
n = 1

            

' Définir le chemin d'accès à la base
sPath = "C:\Users\Portable\Desktop\cartonette\"
' Définir le nom de la base
sBase = "Base_cartonette.accdb"

For m = 4 To 17
    If Cells(m, 1) <> "" Then
        A = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(m, 1)
        b = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(m, 2)
        c = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(m, 23)
    End If
        
    ' Ouvrir la base en tant que nouveau classeur
    Workbooks.Opendatabase Filename:=sPath & sBase, _
                     CommandText:=Array("Données_total"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
    ' Avec ce classeur actif
    With ActiveWorkbook.Sheets(1)
    p = 1
    Do Until Cells(p, 2) <> ""
        p = p + 1
    Loop
    Cells(p, 2) = A
    Cells(p, 3) = b
    Cells(p, 4) = c
    Cells(p, 5) = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(2, 22)
    Cells(p, 6) = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(18, 5)
    Cells(p, 7) = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(5, 12)
    Cells(p, 8) = Workbooks("Cartonette.xlsm").Sheets("Feuil1").Cells(5, 3)
    End With
    ActiveWorkbook.Close False
Next m
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 153
Membres
103 137
dernier inscrit
Billly