[Resolvido]Transferir dados de duas tabelas para uma terceira, onde a coluna de uma delas deve repetir

Boa Noite a Todos !

Estou precisando tranferir os dados de duas tabelas para uma terceira tabela,
Isso que estou necessitando é por causa que quando eu importo uma XML ela vem cheio de tabelas, onde queria fazer a ligação dos produtos com a chave na nota entende
Exemplo
tb_OrigemA -------- tem apenas um registro
Campo1
Linha1_A

tb_OrigemB ----------- tem VARIOS registros
Campo1
Linha1_B
Linha2_B
Linha3_B
Linha4_B

tb_Destino -------------- teria que vir os dados assim
Campo1 Campo2
Linha1_A Linha1_B
Linha1_A Linha2_B
Linha1_A Linha3_B
Linha1_A Linha4_B

Boa tarde
Qual relação entre os campos da importação?

ai esta o problema em uma tabelas a ha vários produtos e nas outras o cabeçaria porem nenhuma tem informações semelhantes

Pessoal consegui escrever o código que eu desejava depois de 4 dias,
1º - criei um tabela onde receberia os dados da nota menos os produtos
2º - criei uma outra tabela que receberia os dados dos produtos
nessas duas tabelas eu inclui a Chave NF-e assim consigo relacioná-las, o código fico grande mas caso alguém necessite esta ai



'========================= Listar Nomes dos Arquivos da Pasta ======
'Verifica todos os arquivos .xml
Dim VarArquivo As String
VarArquivo = dir(Me.txt_Pasta & "\*.xml", vbArchive) 'txt_Pasta é o caminho dos arquivos
'Adiaciona todos na lista com o nome de ListaArq
Do While VarArquivo <> ""
ListaArq.AddItem (VarArquivo)
VarArquivo = dir
Loop
'============================================================
'Conta Total de Arquivos da Lista
Dim Tot_Arq As String
Tot_Arq = Me.ListaArq.ListCount()
'pega o nome um por um e vai jogando em uma variavel de nome "e"
Dim i As Long
Dim e As Long
e = 0

For i = 0 To Tot_Arq - 1
Dim nometemp As String
nometemp = Me.ListaArq.ItemData(e)
Me.txt_NomeArq = nometemp 'vai jogando o nome para o campo txt_NomeArq

Dim ArqSele As String
ArqSele = ListaArq.ItemData(e) 'variavel que pega o nome do arquivo selecionado



'=================================== Importa a XML com dados e estruturas ==================================================================
On Error Resume Next
Dim dirXML As Variant
dirXML = Me.txt_Pasta & Me.txt_NomeArq

Application.ImportXML _
DataSource:=dirXML, _
ImportOptions:=acStructureAndData
Me.Requery

'================================== Transfere os Dados Para Juntar em uma unica tabelas os dados do cabeçario ============
' Com excessão dos produtos o resta vai tudo para essa tabela
On Error Resume Next
Dim BD_Cabecario As DAO.Database 'Cria a Conexão com o Banco de Dados
Dim TB_NFe As DAO.Recordset 'Cria a Conexão com a Tabela
Dim TB_NFe_Produtos As DAO.Recordset
Dim TB_Prod As DAO.Recordset
Dim TB_Chave As DAO.Recordset
Dim TB_Emit As DAO.Recordset
Dim TB_Dest As DAO.Recordset

Set BD_Cabecario = CurrentDb 'referencia o banco de dados
Set TB_NFe = BD_Cabecario.OpenRecordset("tb_XML_NFe")
Set TB_NFe_Produtos = BD_Cabecario.OpenRecordset("tb_XML_NFe_Produtos")
Set TB_Prod = BD_Cabecario.OpenRecordset("prod")
Set TB_Chave = BD_Cabecario.OpenRecordset("infProf")
Set TB_Emit = BD_Cabecario.OpenRecordset("emit")
Set TB_Dest = BD_Cabecario.OpenRecordset("dest")

'Inclui informações de apenas uma linha
TB_NFe.AddNew 'Comando que esta sendo execuldado de adicionar, se foce para deletar seria TB.Delete
TB_NFe!Chave = DLookup("chNFe", "infProt", "chNFe <> '0'")
TB_NFe!NF = DLookup("nNF", "ide", "nNF <> '0'")
TB_NFe!Nome_Emit = DLookup("xNome", "emit", "xNome <> '0'")
TB_NFe!CNPJ_Emit = DLookup("CNPJ", "emit", "CNPJ <> '0'")
TB_NFe!IE_Emit = DLookup("IE", "emit", "IE <> '0'")
TB_NFe!CRT_Emit = DLookup("CRT", "emit", "CRT <> '0'") ' não esta puxando
TB_NFe!UF_Emit = DLookup("UF", "emit", "UF <> '0'") ' não esta puxando

TB_NFe!Nome_Dest = DLookup("xNome", "dest", "xNome <> '0'")
TB_NFe!CNPJ_Dest = DLookup("CNPJ", "dest", "CNPJ <> '0'")
TB_NFe!CPF_Dest = DLookup("CPF", "dest", "CPF <> '0'")
TB_NFe!IE_Dest = DLookup("IE", "dest", "IE <> '0'")
TB_NFe!UF_Dest = DLookup("UF", "dest", "UF <> '0'") ' não esta puxando


TB_NFe.Update ' atualiza os registros





'=================================================== PRODUTOS ==========================================
'Loop Simples para os produtos com chave
Dim tot_tb As String
tot_tb = DCount("[xProd]", "prod") 'Contar o total de registro para o loop
MsgBox (tot_tb)

Dim a As Long
DoCmd.GoToRecord , "", acFirst ' vai para o primeiro registro

For a = 1 To tot_tb Step 1

TB_NFe_Produtos.AddNew
TB_NFe_Produtos!Desc_Prod = TB_Prod!xProd
TB_NFe_Produtos!NCM_Prod = TB_Prod!NCM
TB_NFe_Produtos!CFOP_Prod = TB_Prod!CFOP
TB_NFe_Produtos!Quant_Prod = TB_Prod!qCom


TB_NFe_Produtos!CH_Prod = DLookup("chNFe", "infProt", "chNFe <> '0'")
TB_NFe_Produtos.Update
TB_Prod.Update
TB_Chave.Update

TB_NFe_Produtos.MoveNext
TB_Prod.MoveNext
TB_Chave.MoveNext
Next


'fecha as conexões
TB_NFe.Close
Set TB_NFe = Nothing
BD_Cabecario.Close
Set BD_Cabecario = Nothing

TB_NFe_Produtos.Close
Set TB_NFe_Produtos = Nothing
TB_Prod.Close
Set TB_Prod = Nothing
TB_Chave.Close
Set TB_Chave = Nothing
TB_Emit.Close
Set TB_Emit = Nothing
TB_Dest.Close
Set TB_Dest = Nothing



'================================== Deleta as tabelas, para poder importar aproxima =========================================================
On Error Resume Next
DoCmd.DeleteObject acTable, "autXML"
DoCmd.DeleteObject acTable, "COFINSAliq"
DoCmd.DeleteObject acTable, "COFINSNT"
DoCmd.DeleteObject acTable, "dest"
DoCmd.DeleteObject acTable, "det"
DoCmd.DeleteObject acTable, "detPag"
DoCmd.DeleteObject acTable, "dup"
DoCmd.DeleteObject acTable, "emit"
DoCmd.DeleteObject acTable, "enderDest"
DoCmd.DeleteObject acTable, "enderEmit"
DoCmd.DeleteObject acTable, "fat"
DoCmd.DeleteObject acTable, "ICMS00"
DoCmd.DeleteObject acTable, "ICMS20"
DoCmd.DeleteObject acTable, "ICMS60"
DoCmd.DeleteObject acTable, "ICMS70"
DoCmd.DeleteObject acTable, "ICMSTot"
DoCmd.DeleteObject acTable, "ide"
DoCmd.DeleteObject acTable, "importarError"
DoCmd.DeleteObject acTable, "imposto"
DoCmd.DeleteObject acTable, "infAdic"
DoCmd.DeleteObject acTable, "infProt"
DoCmd.DeleteObject acTable, "infRespTec"
DoCmd.DeleteObject acTable, "IPI"
DoCmd.DeleteObject acTable, "IPINT"
DoCmd.DeleteObject acTable, "obsCont"
DoCmd.DeleteObject acTable, "PISAliq"
DoCmd.DeleteObject acTable, "PISNT"
DoCmd.DeleteObject acTable, "prod" 'essa não sera deletada, pelo menos por enquanto
DoCmd.DeleteObject acTable, "Reference"
DoCmd.DeleteObject acTable, "Signature"
DoCmd.DeleteObject acTable, "Signedinfo"
DoCmd.DeleteObject acTable, "Transforms"
DoCmd.DeleteObject acTable, "transp"
DoCmd.DeleteObject acTable, "vol"
DoCmd.DeleteObject acTable, "X509Data"


MsgBox (ArqSele) ' mensagem apenas para teste

e = i + 1
Next i