Boa noite,
Gostaria de poder exportar varias abas de planilha em um uni txt..
alguém poderia me ajudar?
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
unir varias planilhas de arquivo excel em um TXT
-
- Acabou de chegar
- Mensagens: 8
- Registrado em: Ter Jul 23, 2019 9:33 am
-
- Manda bem
- Mensagens: 127
- Registrado em: Sex Out 05, 2018 2:42 pm
Re: unir varias planilhas de arquivo excel em um TXT
Tudo bom amigo Leandro ,
Segue um método, mas acredito que nossos amigos Jedi's vão ter ideias melhores, mas já vai um método ai para ver se ajuda, outro fato para ajudar é sempre colocar aqui compactado um arquivo modelo que eles vão conseguir te ajudar melhor, fica muito ruim entender sem modelo.
Segue....
Sub GeraTxt()
Dim Tempo As Double
Tempo = Now()
Caminho = ThisWorkbook.Path & Application.PathSeparator
arquivo = "TESTE" & ".txt"
Open Caminho & arquivo For Output As #1
Worksheets("Planilha1").Activate 'ABA 1
Range("A1").Select
Linha = 1
Do Until IsEmpty(ActiveCell.Offset(0, 0))
Cpo1 = Cells(Linha, 1)
Dados = Cpo1
Print #1, Dados
Linha = Linha + 1
If Cells(Linha, 1) = Empty Then Exit Do
Loop
Worksheets("Planilha2").Activate 'ABA 2
Range("A1").Select
Linha = 1
Do Until IsEmpty(ActiveCell.Offset(0, 0))
Cpo1 = Cells(Linha, 1)
Dados = Cpo1
Print #1, Dados
Linha = Linha + 1
If Cells(Linha, 1) = Empty Then Exit Do
Loop
Worksheets("Planilha3").Activate 'ABA 3
Range("A1").Select
Linha = 1
Do Until IsEmpty(ActiveCell.Offset(0, 0))
Cpo1 = Cells(Linha, 1)
Dados = Cpo1
Print #1, Dados
Linha = Linha + 1
If Cells(Linha, 1) = Empty Then Exit Do
Loop
Close #1
MsgBox "Gerado com Sucesso"
MsgBox Now() - Tempo
End Sub
E vai colocando a aba que queres e qual colunas queres extrair
E caso queria unir varias abas em uma única segue:
Sub Consolidar()
Sheets(1).Range("A5:N2000").Clear
plans = Sheets.Count
linha = 2
For n = 2 To plans
lin = 2
Do Until Sheets(n).Cells(lin, 1) = ""
Sheets(1).Cells(linha, 1) = Sheets(n).Cells(lin, 1)
Sheets(1).Cells(linha, 2) = Sheets(n).Cells(lin, 2)
Sheets(1).Cells(linha, 3) = Sheets(n).Cells(lin, 3)
Sheets(1).Cells(linha, 4) = Sheets(n).Cells(lin, 4)
Sheets(1).Cells(linha, 5) = Sheets(n).Cells(lin, 5)
Sheets(1).Cells(linha, 6) = Sheets(n).Cells(lin, 6)
Sheets(1).Cells(linha, 7) = Sheets(n).Cells(lin, 7)
Sheets(1).Cells(linha, 8) = Sheets(n).Cells(lin, 8)
Sheets(1).Cells(linha, 9) = Sheets(n).Cells(lin, 9)
Sheets(1).Cells(linha, 10) = Sheets(n).Cells(lin, 10)
Sheets(1).Cells(linha, 11) = Sheets(n).Cells(lin, 11)
Sheets(1).Cells(linha, 12) = Sheets(n).Cells(lin, 12)
Sheets(1).Cells(linha, 13) = Sheets(n).Cells(lin, 13)
Sheets(1).Cells(linha, 14) = Sheets(n).Cells(lin, 14)
Sheets(1).Cells(linha, 16).Font.ColorIndex = n + 1
Sheets(1).Cells(linha, 16) = Sheets(n).Name
lin = lin + 1
linha = linha + 1
Loop
Next
End Sub
é importante sempre verificar bem o que precisas e explanar ou colocar um modelo, ai o pessoal vai dar de letra no que precisas.
Segue um método, mas acredito que nossos amigos Jedi's vão ter ideias melhores, mas já vai um método ai para ver se ajuda, outro fato para ajudar é sempre colocar aqui compactado um arquivo modelo que eles vão conseguir te ajudar melhor, fica muito ruim entender sem modelo.
Segue....
Sub GeraTxt()
Dim Tempo As Double
Tempo = Now()
Caminho = ThisWorkbook.Path & Application.PathSeparator
arquivo = "TESTE" & ".txt"
Open Caminho & arquivo For Output As #1
Worksheets("Planilha1").Activate 'ABA 1
Range("A1").Select
Linha = 1
Do Until IsEmpty(ActiveCell.Offset(0, 0))
Cpo1 = Cells(Linha, 1)
Dados = Cpo1
Print #1, Dados
Linha = Linha + 1
If Cells(Linha, 1) = Empty Then Exit Do
Loop
Worksheets("Planilha2").Activate 'ABA 2
Range("A1").Select
Linha = 1
Do Until IsEmpty(ActiveCell.Offset(0, 0))
Cpo1 = Cells(Linha, 1)
Dados = Cpo1
Print #1, Dados
Linha = Linha + 1
If Cells(Linha, 1) = Empty Then Exit Do
Loop
Worksheets("Planilha3").Activate 'ABA 3
Range("A1").Select
Linha = 1
Do Until IsEmpty(ActiveCell.Offset(0, 0))
Cpo1 = Cells(Linha, 1)
Dados = Cpo1
Print #1, Dados
Linha = Linha + 1
If Cells(Linha, 1) = Empty Then Exit Do
Loop
Close #1
MsgBox "Gerado com Sucesso"
MsgBox Now() - Tempo
End Sub
E vai colocando a aba que queres e qual colunas queres extrair
E caso queria unir varias abas em uma única segue:
Sub Consolidar()
Sheets(1).Range("A5:N2000").Clear
plans = Sheets.Count
linha = 2
For n = 2 To plans
lin = 2
Do Until Sheets(n).Cells(lin, 1) = ""
Sheets(1).Cells(linha, 1) = Sheets(n).Cells(lin, 1)
Sheets(1).Cells(linha, 2) = Sheets(n).Cells(lin, 2)
Sheets(1).Cells(linha, 3) = Sheets(n).Cells(lin, 3)
Sheets(1).Cells(linha, 4) = Sheets(n).Cells(lin, 4)
Sheets(1).Cells(linha, 5) = Sheets(n).Cells(lin, 5)
Sheets(1).Cells(linha, 6) = Sheets(n).Cells(lin, 6)
Sheets(1).Cells(linha, 7) = Sheets(n).Cells(lin, 7)
Sheets(1).Cells(linha, 8) = Sheets(n).Cells(lin, 8)
Sheets(1).Cells(linha, 9) = Sheets(n).Cells(lin, 9)
Sheets(1).Cells(linha, 10) = Sheets(n).Cells(lin, 10)
Sheets(1).Cells(linha, 11) = Sheets(n).Cells(lin, 11)
Sheets(1).Cells(linha, 12) = Sheets(n).Cells(lin, 12)
Sheets(1).Cells(linha, 13) = Sheets(n).Cells(lin, 13)
Sheets(1).Cells(linha, 14) = Sheets(n).Cells(lin, 14)
Sheets(1).Cells(linha, 16).Font.ColorIndex = n + 1
Sheets(1).Cells(linha, 16) = Sheets(n).Name
lin = lin + 1
linha = linha + 1
Loop
Next
End Sub
é importante sempre verificar bem o que precisas e explanar ou colocar um modelo, ai o pessoal vai dar de letra no que precisas.
-
- Manda bem
- Mensagens: 127
- Registrado em: Sex Out 05, 2018 2:42 pm