no era eso a lo que me referia
a lo que me referia yo era a esto
Agregar datos a una nueva tabla de una base de datos de Access
En este ejemplo se agrega una nueva tabla a la base de datos neptuno.mdb. A continuación, la subrutina rellena la tabla con los datos que se encuentran en las celdas S1:V30 de esta hoja de cálculo. Para ello es necesario que el archivo neptuno.mdb esté in
Sub CreateTable()
''' NOTA: Para utilizar esta subrutina, es necesario crear
''' una referencia a la versión más reciente
''' de la siguiente biblioteca:
''
'' Biblioteca de objetos de datos ActiveX de Microsoft
'' Ext. Microsoft ADO 2.1 para DDL y seguridad
' Las primeras cuatro líneas Dim simultáneamente declaran y
' crean nuevos objetos. Puede utilizar esta sintaxis o bien
' utilizar la declaración Set para crear los objetos.
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 looprange As Range
Dim currcell As Range
With conn
' Establece el proveedor OleDB para la conexión.
.Provider = "Microsoft.JET.OLEDB.4.0"
' Abre una conexión a Neptuno.mdb.
.Open Application.Path & "\samples\neptuno.mdb"
End With
' Establece la conexión activa para el objeto Catalog.
cat.ActiveConnection = conn
With tbl
' Asigna un nombre a la nueva tabla.
.Name = "Tabla_de_ventas"
' Asigna un nombre a las columnas de la nueva tabla.
With .Columns
.Append "Nombre"
.Append "Región"
.Append "Producto"
' La columna Sales debe ser de tipo de datos "Moneda".
.Append "Ventas", adCurrency
End With
End With
' Agrega la tabla a la base de datos.
cat.Tables.Append tbl
With rst
.ActiveConnection = conn
' Abre la nueva tabla. El argumento LockType del método
' Open debe establecerse a adLockOptimistic a fin de
' agregar registros a la tabla.
.Open "Tabla_de_ventas", LockType:=adLockOptimistic
End With
' Establece el rango de la hoja activa que contiene
' los registros que se añadirán a la base de datos.
Set looprange = Range("s2", Range("s2").End(xlDown))
' Examina la información de la hoja de cálculo.
For Each currcell In looprange
With rst
' Agrega un nuevo registro.
.AddNew
' Agrega información a los campos correspondientes.
.Fields("Nombre").Value = currcell.Value
.Fields("Región").Value = currcell.Offset(0, 1).Value
.Fields("Producto").Value = currcell.Offset(0, 2).Value
.Fields("Ventas").Value = currcell.Offset(0, 3).Value
' Escribe el nuevo registro a la base de datos.
.Update
End With
Next currcell
rst.Close
Set tbl = Nothing
Set cat = Nothing
conn.Close
End Sub
igualmente gracias poor tu respuesta.