unir varias planilhas de arquivo excel em um TXT

[leonardo092004]

Boa noite,

Gostaria de poder exportar varias abas de planilha em um uni txt..
alguém poderia me ajudar?

[Julio Mangilli]

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.

[Julio Mangilli]

Perdão, Leonardo seu nome..