[Resolvido]Transpor uma coluna em varias colunas

Olá Amigos,

Preciso criar uma função para transpor uma coluna em uma tabela de 8 campos.

Alguem tem algum exemplo para isso?

Dt.Pagto : 01/06/2010
Forma Pagto : CREDITO EM CONTA
Banco/Agência : xxx/xxx Conta Corrente: xxxxx/x
Obrigação : 4230776/1
Nota Fiscal : 3768/IS
Valor NF : 438,34
Viagem : 2404082
Valor Pago : 438,34
Dt.Pagto : 01/06/2010
Forma Pagto : CREDITO EM CONTA
Banco/Agência : xxx/xxx Conta Corrente: xxxxx/x
Obrigação : 4230777/1
Nota Fiscal : 3770/IS
Valor NF : 269,17
Viagem : 2404063
Valor Pago : 269,17
Dt.Pagto : 01/06/2010
Forma Pagto : CREDITO EM CONTA
Banco/Agência : xxx/xxx Conta Corrente: xxxxx/x
Obrigação : 4230779/1
Nota Fiscal : 453039019/IS
Valor NF : 495,00
Viagem : 2404082
Valor Pago : 495,00

Desde já agradeço

Sds,

Boa tarde,

Tente assim (não testei)

Sub Transpoe()
Dim rst1 as dao.recordset,rst2 as dao.recordset

set rst1=currentdb.openrecordset("TabelaOuConsulta1Coluna")
set rst2=currentdb.openrecordset("TabelaDos8Campos")

do
if rst1.eof or isnull(rst1(0)) then
exit do
else
rst2.edit
rst2("Campo1")=rst1(0):rst1.movenext
rst2("Campo2")=rst1(0):rst1.movenext
rst2("Campo3")=rst1(0):rst1.movenext
rst2("Campo4")=rst1(0):rst1.movenext
rst2("Campo5")=rst1(0):rst1.movenext
rst2("Campo6")=rst1(0):rst1.movenext
rst2("Campo7")=rst1(0):rst1.movenext
rst2("Campo8")=rst1(0):rst1.movenext
rst2.update
end if
while
set rst1=nothing: set rst2=nothing
end sub

Cumprimentos,

Grande Alexandre,

Obrigado pela ajuda, funcionou com pequenas modificações.

Public Function Transpoe()
Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset

Set rst1 = CurrentDb.OpenRecordset("Txttranspor")
Set rst2 = CurrentDb.OpenRecordset("TabelaTransposta")

Do While Not rst1.EOF

If rst1.EOF Or IsNull(rst1(0)) Then
Exit Do
DoCmd.CancelEvent
Else
rst2.AddNew
rst2("Campo1") = rst1(0): rst1.MoveNext
rst2("Campo2") = rst1(0): rst1.MoveNext
rst2("Campo3") = rst1(0): rst1.MoveNext
rst2("Campo4") = rst1(0): rst1.MoveNext
rst2("Campo5") = rst1(0): rst1.MoveNext
rst2("Campo6") = rst1(0): rst1.MoveNext
rst2("Campo7") = rst1(0): rst1.MoveNext
rst2("Campo8") = rst1(0): rst1.MoveNext
rst2.Update
End If
Loop

Set rst1 = Nothing: Set rst2 = Nothing
End Function

Agora só falta tratar o rst1 para capturar só o que vem depois dos ":"(Dois Pontos)

Boa tarde,

Pensei que a primeira parte era informativa.
Utilize a função instr
Cumprimentos,

Valeu Alexandre por mais esta

Obrigado

Sds,