[Resolvido]Duplicar Resultados

Boa tarde, tenho uma tabela "TabLotes" a qual controla os lotes de produção, esta é vinculada a dezenas de outras tabelas que contem os resultados dos mais diversos tipos de testes de controle de qualidade, desta foma consigo analisar os resultados de todos os testes pelo ID da TabLotes, contudo os resultados de alguns testes são comuns a vários lotes, entretanto tem sido necessário digitar lote por lote..... gostaria de saber que alguém conhece uma forma de replicar os resultados de um teste contudo alterando o ID para um diferente lote da "TabLotes", o botão Duplicar simplesmente duplica tudo para o lote já selecionado, tentei das mais diferentes formas mas não consegui.

já tentou consulta acrescimo

Sim, o problema foi que na consulta acréscimo o ID da tabLotes repetiu também.

Anexo um detalhamento do problema para uma melhor entendimento.

Boa tarde
Disponibilize dados significativos para se trabalhar

O sistema possui 190 MB no gerenciador e outros 26 Gb de tabelas infelizmente não tenho como disponibilizar um anexo.......

mas agradeço o interesse em ajudar, obrigado.

Como base nas suas informações fiz um exemplo imagino que seja mais ou menos isto a sua base

Private Sub btAdd_Click()
'Scandinavo 05/04/19
'Faz a copia de registros de um subformulario

'Estando em um registro aberto e querendo duplicar informa??es para um novo lote
'Lembre se duplicar achave primaria vai dar erro
Dim NovoLote As String
NovoLote = InputBox("Informe o numero do novo lote para duplicar estas informa??es:", "Aten?ao")

Dim db As dao.Database
Dim rstL As dao.Recordset 'tabela lotes
Dim rst As dao.Recordset 'subfrmlario
Dim rstR As dao.Recordset 'tabela resultados
'primeiro tem que salvar este novo lote na tabela principal
Set db = CurrentDb()
Set rstL = db.OpenRecordset("tblLote")
rstL.AddNew
rstL!IdLote = NovoLote
rstL.Update
DoCmd.RunCommand acCmdSaveRecord 'Salvo o Registro na tblLote primeiro
'abre a tabela para inserir os registros copiados
Set rstR = db.OpenRecordset("tblResultados")
'fazendo referencia ao sub formulario
Set rst = Me.subfrmLoteResultado.Form.Recordset
rst.MoveFirst 'Vai percorrer todo o subformulario
Do While Not rst.EOF ' ate o fim
With rst
rstR.AddNew
rstR!Lote = NovoLote 'este ? da variavel com o novo lote
'estes s?o campos que voce quer copiar
rstR!Setor = rst!Setor
rstR!NomeFunc = rst!NomeFunc
rstR!Funcao = rst!Funcao
rstR.Update
.MoveNext
End With
Loop

MsgBox ("Resultados copiados"), vbInformation, "Copia"
Set rstL = Nothing
Set rst = Nothing
Set rstR = Nothing


End Sub

Ficou Espetacular, muito agradecido mesmo, tem apenas um item que vou tentar ajustar, refere-se ao numero do lote, este é criado antes mesmo desta duplicação, por exemplo, um lote pode ser criado no dia 04/03/2019 LOTE "GRP040319-D1" e um resultado lançado para ele no dia 10/03/2019, então ao invés de:

Dim NovoLote As String
NovoLote = InputBox("Informe o numero do novo lote para duplicar estas informações:", "Atençao")

Deveria ser, "selecione o lote que deseja duplicar as informações:" buscando este informação no campo lote da tabLotes.

coloca um cmbox para trazer estes lotes e seleciona a qual você quer inserir estes dados duplicados.
ai é só arrumar o código para pegar o lote desta comb ao invés do imputbox

Olha como esta ficando o código:

Creio que com mais alguns ajustes vou conseguir, deixei as linhas do código onde inseria um novo lote como comentário até ficar tudo 100%

Criei uma cmbBox com o nome Pendente, esta busca os lotes que ainda não possuem os resultado do teste selecionado.

Private Sub Pendente_AfterUpdate()
'Scandinavo 05/04/19
'Faz a copia de registros de um subformulario

'Estando em um registro aberto e querendo duplicar informações para um novo lote
'Lembre se duplicar achave primaria vai dar erro
Dim NovoLote As String
NovoLote = Me.Pendente
Dim db As dao.Database
Dim rstL As dao.Recordset 'tabela lotes
Dim rst As dao.Recordset 'subfrmlario
Dim rstR As dao.Recordset 'tabela resultados
'primeiro tem que salvar este novo lote na tabela principal
Set db = CurrentDb()
Set rstL = db.OpenRecordset("TabLotes")
'rstL.AddNew
'rstL!Lote = NovoLote
'rstL.Update
'DoCmd.RunCommand acCmdSaveRecord 'Salvo o Registro na tblLote primeiro
'abre a tabela para inserir os registros copiados
Set rstR = db.OpenRecordset("TabVacuoPressao")
'fazendo referencia ao sub formulario
Set rst = Me.SubLancarVacuoPressao.Form.Recordset
rst.MoveFirst 'Vai percorrer todo o subformulario
Do While Not rst.EOF ' ate o fim
With rst
rstR.AddNew
rstR!Lote = NovoLote 'este é da variavel com o novo lote
'estes são campos que voce quer copiar
rstR!Tipo = rst!Tipo
rstR!Chapa = rst!Chapa
rstR!Miolo1Forca = rst!Miolo1Forca
rstR!Miolo2Forca = rst!Miolo2Forca
rstR!Miolo3Forca = rst!Miolo3Forca
rstR!Miolo4Forca = rst!Miolo4Forca
rstR!Miolo5Forca = rst!Miolo5Forca
rstR!Miolo6Forca = rst!Miolo6Forca
rstR!Miolo1Fibra = rst!Miolo1Fibra
rstR!Miolo2Fibra = rst!Miolo2Fibra
rstR!Miolo3Fibra = rst!Miolo3Fibra
rstR!Miolo4Fibra = rst!Miolo4Fibra
rstR!Miolo5Fibra = rst!Miolo5Fibra
rstR!Miolo6Fibra = rst!Miolo6Fibra
rstR!Analista = rst!Analista
rstR!Data = rst!Data
rstR.Update
.MoveNext
End With
Loop

MsgBox ("Resultados copiados"), vbInformation, "Copia"
Set rstL = Nothing
Set rst = Nothing
Set rstR = Nothing
End Sub

é isso ai tem mais algumas linha que você pode comentar.
sugestão quando eu uso uma comb gosto de colocar no nome do campo o tipo que ele é
por exemplo cmbPendente fica fácil para trabalhar no código

Adaptando a minha necessidade o código final ficou da seguinte forma:


Private Sub Pendente_AfterUpdate()
'Scandinavo 05/04/19
'Faz a copia de registros de um subformulario

'Estando em um registro aberto e querendo duplicar informações para um diferente lote
'Lembre se duplicar achave primaria vai dar erro

Datst = InputBox("Informe a data do teste para duplicar estas informações:", "Atençao")'Para definir uma data diferente para os resultados

Dim Datst As Date
Dim NovoLote As String
NovoLote = Me.Pendente
Dim db As DAO.Database
Dim rstL As DAO.Recordset 'tabela lotes
Dim rst As DAO.Recordset 'subfrmlario
Dim rstR As DAO.Recordset 'tabela resultados
'primeiro tem que salvar este novo lote na tabela principal
Set db = CurrentDb()
Set rstL = db.OpenRecordset("TabLotes")
Set rstR = db.OpenRecordset("TabResultados")'pode ser qualquer tabela com resultados ligada a TabLotes
'fazendo referencia ao sub formulario
Set rst = Me.SubLancarResultados.Form.Recordset
rst.MoveFirst 'Vai percorrer todo o subformulario
Do While Not rst.EOF ' ate o fim
With rst
rstR.AddNew
rstR!Lote = NovoLote 'este é da variavel com o novo lote
rstR!Data = Datst 'Aqui a nova data vinda do InputBox
'estes são campos que voce quer copiar
rstR!Turno = rst!Turno

rstR!E1 = rst!E1
rstR!E2 = rst!E2
rstR!E3 = rst!E3
rstR!E4 = rst!E4
rstR!E5 = rst!E5
rstR!E6 = rst!E6
rstR!E7 = rst!E7
rstR!E8 = rst!E8
rstR!Analista = rst!Analista
rstR.Update
.MoveNext
End With
Loop

MsgBox ("Resultados copiados"), vbInformation, "Copia"
Set rstL = Nothing
Set rst = Nothing
Set rstR = Nothing

End Sub

Scandinavo muito obrigado pela pronta resposta e ajuda!

Boa noite,
Não deve alterar o título
Deve premir o botão "Resolvido" na zona inferior direita do formulário do fórum

Adaptando a minha necessidade o código final ficou da seguinte forma:


Private Sub Pendente_AfterUpdate()
'Scandinavo 05/04/19
'Faz a copia de registros de um subformulario

'Estando em um registro aberto e querendo duplicar informações para um diferente lote
'Lembre se duplicar achave primaria vai dar erro

Datst = InputBox("Informe a data do teste para duplicar estas informações:", "Atençao")'Para definir uma data diferente para os resultados

Dim Datst As Date
Dim NovoLote As String
NovoLote = Me.Pendente
Dim db As DAO.Database
Dim rstL As DAO.Recordset 'tabela lotes
Dim rst As DAO.Recordset 'subfrmlario
Dim rstR As DAO.Recordset 'tabela resultados
'primeiro tem que salvar este novo lote na tabela principal
Set db = CurrentDb()
Set rstL = db.OpenRecordset("TabLotes")
Set rstR = db.OpenRecordset("TabResultados")'pode ser qualquer tabela com resultados ligada a TabLotes
'fazendo referencia ao sub formulario
Set rst = Me.SubLancarResultados.Form.Recordset
rst.MoveFirst 'Vai percorrer todo o subformulario
Do While Not rst.EOF ' ate o fim
With rst
rstR.AddNew
rstR!Lote = NovoLote 'este é da variavel com o novo lote
rstR!Data = Datst 'Aqui a nova data vinda do InputBox
'estes são campos que voce quer copiar
rstR!Turno = rst!Turno

rstR!E1 = rst!E1
rstR!E2 = rst!E2
rstR!E3 = rst!E3
rstR!E4 = rst!E4
rstR!E5 = rst!E5
rstR!E6 = rst!E6
rstR!E7 = rst!E7
rstR!E8 = rst!E8
rstR!Analista = rst!Analista
rstR.Update
.MoveNext
End With
Loop

MsgBox ("Resultados copiados"), vbInformation, "Copia"
Set rstL = Nothing
Set rst = Nothing
Set rstR = Nothing

End Sub

Scandinavo muito obrigado pela pronta resposta e ajuda!

valeu pelo retorno e bom que funcionou até mais.