Access - Copiar registros

Hola a todos estoy intentando copiar registros de una tabla a otra. En el ejemplo que os envio los registros que cuyo id es 441 son exactamente 3. Lo que me hace ahora mismo es copiar 3 veces el primer registro y lo que yo quiero es copiar los valores de los tres registros. A ver si alguien me puede echar una mano gracias.

Dim rst As DAO.Recordset
Dim Pst As DAO.Recordset
Dim db As Database
Set db = CurrentDb
Set rst = CurrentDb.OpenRecordset("select * From [PREPARACION PEDIDO (REFERENCIAS)] where [ENTPRE]= 441")
Set Pst = db.OpenRecordset("PEDIDOS_ENTRADAS")

If rst.RecordCount > 0 Then
rst.MoveLast
rst.MoveFirst
End If
Do While Not rst.EOF
rst.Edit
With Pst
.AddNew
![Nº ENTRADA] = [IDREF]
!ENTRADA = [CANT]
![IMPORTE DOLAR] = [FOBNUEVO]
.Update
End With
rst.MoveNext
Loop

MsgBox ("Registros copiados")

AVISO:
End Sub

Hola,

Me temo que tienes algunos errores...
1. El rst.Edit no hace nada de nada
2. En la asignacion de valores al Recordset Pst, no haces referencia al origen de los datos.
3. No cierras los Recordsets

Opción 1: Doble recordset suponiendo que tienes un campo en el formulario que contiene el valor de ENTPRE, asi te vale para cualquier valor. Tambien se supone que quieres asignar los valores de Nº ENTRADA, ENTRADA e IMPORTE DOLAR en base a los valores del Recordset rst en sus campos IDREF, CANT y FOBNUEVO.

Dim rst As DAO.Recordset
Dim pst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT * FROM [PREPARACION PEDIDO (REFERENCIAS)] WHERE [ENTPRE]=" & Me!campoENTPRE)
Set pst = CurrentDb.OpenRecordset("PEDIDOS_ENTRADAS")
rst.Movelast
If rst.RecordCount =0 Then
MsgBox "No hay registros que copiar", vbCritical, "El que todo lo ve dice..."
Exit Sub
End If
rst.MoveFirst
While Not rst.EOF
pst.AddNew
pst![Nº ENTRADA] = rst![IDREF]
pst!ENTRADA = rst![CANT]
pst![IMPORTE DOLAR] = rst![FOBNUEVO]
pst.Update
rst.MoveNext
Wend
rst.Close
pst.Close
Set rst = Nothing
Set pst = Nothing
MsgBox "Registros copiados", vbInformation, "El que todo lo ve dice..."

Opcion 2: Un recordset + 1 consulta de datos anexados. Los mismos supuestos que la opcion 1. Tambien se han supuesto que los valores son numericos.

Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT * FROM [PREPARACION PEDIDO (REFERENCIAS)] WHERE [ENTPRE]=" & Me!campoENTPRE)
rst.Movelast
If rst.RecordCount =0 Then
MsgBox "No hay registros que copiar", vbCritical, "El que todo lo ve dice..."
Exit Sub
End If
rst.MoveFirst
While Not rst.EOF
CurrentDb.Execute "INSERT INTO PEDIDOS_ENTRADAS (Nº ENTRADA, ENTRADA, [IMPORTE DOLAR]) VALUES(" & rst![IDREF] & ", " & rst![CANT] & ", " & rst![FOBNUEVO] & ")"
Wend
rst.Close
Set rst = Nothing
MsgBox "Registros copiados", vbInformation, "El que todo lo ve dice..."

Los codigos estan escritos del tiron

Un saludo

Xavi

Muchas gracias. Perfecto es lo que necesitaba. Gracias.

De nada
:o)

Otra cosilla. Si ahora yo lo que quiero es modificar un registro no añadirlo no solo es utilizando .edit en lugar de .addnew no? Estoy intentandolo y no hace lo que quiero a veces me modifica o me añade. Una locura.

Mira e puesto otro boton distinto para modificar un registro ya insertado que hace lo siguiente.

Private Sub Etiqueta140_Click()
Dim rst As DAO.Recordset
Dim pst As DAO.Recordset
Dim dst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("select * From [PREPARACION PEDIDO (REFERENCIAS)] where [ENTPRE]= " & Me!ENTPRE)
Set pst = CurrentDb.OpenRecordset("PEDIDOS_ENTRADAS")
Set dst = CurrentDb.OpenRecordset("select * From [PREPARACION PEDIDO(FECHA)] where [ID]= " & Me!ENTPRE)

rst.MoveLast
If rst.RecordCount = 0 Then
MsgBox ("No hay registros que modificar"), vbCritical
Exit Sub
End If

rst.MoveFirst
While Not rst.EOF
pst.Edit
pst![Nº ENTRADA] = rst![IDREF]
pst!ENTRADA = rst![CANT]
pst![IMPORTE DOLAR] = rst![FOBNUEVO]
pst!AR = rst![ARANCEL]

pst![FECHA] = dst![FECHA ENTRADA]
pst![GASTOS] = dst![GASTOS%]
pst![IVA] = dst![R%]
pst![CAMBIO] = dst![CAMBIO]
pst.Update
rst.MoveNext

Wend
rst.Close
pst.Close
dst.Close
Set rst = Nothing
Set pst = Nothing
Set dst = Nothing

MsgBox ("Registros modificados"), vbInformation
End Sub