bonjour
si j'ai bien compris ta demande , il faut remplacer les retours à la ligne d'Excel : Alt + Entree ( equivalences Chr(10) , Vblf ) par les retours à la ligne d'Access : Ctrl + Entree ( equivalences vbCrLf , Chr(13) + Chr(10))
par macro cela donnerait
Cell = Application.WorksheetFunction.Substitute(Cell, Chr(10), Chr(13) + Chr(10))
dans cet exemple , avant d'effectuer l'export vers Accees , tu selectionnes ta plage de données et tu executes la macro pour mettre en forme les données Excel
Sub Test_V01()
Dim Cell As Range
For Each Cell In Selection
Cell = Application.WorksheetFunction.Substitute(Cell, Chr(10), Chr(13) + Chr(10))
Next Cell
End Sub
ensuite tu peux exporter tes données vers Access
un fois que c'est fait (ou apres un import d'Access) tu peux réinitialiser tes données Excel avec les retours à la ligne standard
Sub Test_V02()
Dim Cell As Range
For Each Cell In Selection
Cell = Application.WorksheetFunction.Substitute(Cell, Chr(13) + Chr(10), Chr(10))
Next Cell
End Sub
sinon l'exemple ci dessous permet de créer directement une nouvelle table dans une base Access et d'y transférer les données de la plage A2:C20000
le premier champ nommé 'Code' contient des retours à la lignes qui vont etre automatiquement remis en forme
Option Explicit
Option Compare Text
'Ajouter une table d'une base de données Access
'***********************************************
Sub CreationTable()
'
'necessite d'activer la reference Microsoft ActiveX Data Objects 2.0 Library
'necessite d'activer la reference Microsoft ADO Ext. 2.5 for DDL and Security
'
Dim Cat As New ADOX.Catalog
Dim Tbl As New ADOX.Table
Dim Conn As New ADODB.Connection
Dim rsT As New ADODB.Recordset
Dim Plage As Range, Cell As Range
Dim maNouvelleTable As String
Dim i As Byte
maNouvelleTable = InputBox('Nommer la nouvelle table (sans espaces )')
If maNouvelleTable = '' Then Exit Sub
With Conn 'se connecter à la base Access
.Provider = 'Microsoft.JET.OLEDB.4.0'
.Open 'C:\\\\\\\\MaBase_V01.mdb'
End With
Cat.ActiveConnection = Conn
'creation d'une nouvelle table*****************
With Tbl
.Name = maNouvelleTable
With .Columns 'definition des noms de champs et des types de donnees
.Append 'Code'
.Append 'Date', adDate
.Append 'Valeurs', adInteger
End With
End With
Cat.Tables.Append Tbl
'**********************************************
With rsT
.ActiveConnection = Conn
.Open maNouvelleTable, LockType:=adLockOptimistic
End With
'transfert des données Excel vers Access
Set Plage = Feuil1.Range('A2:C20000')
For Each Cell In Plage
With rsT
.AddNew
.Fields('Code').Value = _
Application.WorksheetFunction.Substitute(Cell, Chr(10), Chr(13) + Chr(10))
.Fields('Date').Value = Cell.Offset(0, 1)
.Fields('Valeurs').Value = Cell.Offset(0, 2)
.Update
End With
Next Cell
rsT.Close
Set Tbl = Nothing
Set Cat = Nothing
Conn.Close
End Sub
bonne journée
MichelXld