[Resolvido]Erro ao tranferir registros no form continuo para a tabela!

Eu de novo!

Tenho um botão em um formulário continuo!
Exemplo quando abro este form me retorna 3 registros. Até tudo bem.

Estou usando este código no clique do botão: Para transferir do form para uma tabela.

Dim db1 As Database, db2 As Database, rs1 As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset


Set db1 = CurrentDb

Set rs1 = db1.OpenRecordset("TabArmazem", dbOpenTable)

With rs1

.AddNew

![Nome] = Me.Nome
![ValorCompra] = Me.ValorCompra
![DataCompra] = Me.DataCompra
![Compra] = Me.Compra
![DataVencimento] = Me.DataVencimento
![CpValor] = Me.CpValor

.Update

End With


Exemplo:

O form continuo tem 3 registros e está inserindo somente um registro na tabela, onde está o erro. Eu preciso que seja inseridos os 3 registros, se alguem poder me ajudar agradeço.

O código acima insere somente um registro, para inserir mais é preciso utilizar um loop.

topbr olá!

Poderia me ajudar!

Sim claro, é só dizer exatamente o que quer, quer inserir esses 3 registros em outra tabela?

Meu formulário é um formulário continuo, isso depende da consulta as vezes é 3 as vezes é 5 ou 10, entendeu? Depende do cliente pesquisado. Preciso enviar todos os registros que o form filtrou através da consulta.

Essa é uma forma, outra mais fácil seria uma consulta tipo créscimo passando os critérios de sua consulta do form continuo.

'Caso os campos sejam iguais entre as duas tabelas
Dim db1 As Database
Dim db2 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Set db1 = CurrentDb
Set db2 = CurrentDb
'On Error Resume Next
'Aqui deverá ser passado o critério conforme sua consulta
Set rs1 = CurrentDb.OpenRecordset("Select * from TabelaOrigem Where Id=" & Me.IdFilho & "", dbOpenDynaset)

Set rs2 = db2.OpenRecordset("TabArmazem")
rs1.MoveFirst
Do While Not rs1.EOF
rs2.AddNew
rs2!ID = rs1!IDFilhoDoFormulario
rs2!Nome = rs1!Nome
rs2!ValorCompra = rs1!ValorCompra
rs2!DataCompra = rs1!DataCompra
rs2!Compra = rs1!Compra
rs2!DataVencimento = rs1!DataVencimento
rs2!CpValor = rs1!CpValor
rs2.Update
rs1.MoveNext
Loop

msgbox"Dados adicionados"

rs1.Close
rs2.Clone
Set db1 = Nothing
Set db2 = Nothing

Tópico resolvido através de outro tópico.