Macro para Salvar uma Planilha XLS em TXT

Amigos, esta dica de hoje é em resposta a dúvida do leitor Rick.

Será que alguém tem uma macro que salva os dados de uma planilha XLS em TXT?
POR FAVOR PRECISO DE AJUDA.

Seria interessante que você fizesse a leitura do artigo Criar um novo arquivo excel dinamicamente.
Nessa dica vou disponibilizar uma arquivo com uma macro que lista todas as planilhas de um arquivo do Excel para que o usuário possa selecionar uma planilha a ser convertida para txt. O formato txt apenas aceita a conversão de cada planilha individualmente.
Espero que possa ajudá-los. Sintam-se a vontade para modificarem a macro para adequar-se a realidade de seus projetos.
Abraços.
Abaixo, segue a transcrição do código.
Módulo1

Sub SalvarComoTXT()
    UserForm1.Show
End Sub
Sub ExecutarSalvarTXT(mPlan As Worksheet, mPathSave As String)
Dim NovoArquivoXLS As Workbook
    'Cria um novo arquivo excel
    Set NovoArquivoXLS = Application.Workbooks.Add
    'Copia a planilha para o novo arquivo criado
    mPlan.Copy Before:=NovoArquivoXLS.Sheets(1)
    'Salva o arquivo
    Application.DisplayAlerts = False
    NovoArquivoXLS.SaveAs mPathSave & "\" & mPlan.Name & ".txt", _
        FileFormat:=xlText, CreateBackup:=False
    NovoArquivoXLS.Close
    Set NovoArquivoXLS = Nothing
    Application.DisplayAlerts = True
    MsgBox "Novo arquivo salvo em: " & mPathSave & "\" & mPlan.Name & ".txt", vbInformation
End Sub

UserForm1

Private Sub CommandButton1_Click()
    'Chama a rotina para salvar como txt
    'Será salvo um novo arquivo txt com base na planilha seleciona na lista de opções
    Call ExecutarSalvarTXT(Sheets(lstPlanilhas.Text), ThisWorkbook.Path)
    Unload Me   'Fecha o form
End Sub
Private Sub UserForm_Initialize()
    'Chama a rotina para preencher a lista das planilha disponíveis no arquivo
    Call PreencheLista
End Sub
Private Sub PreencheLista()
Dim sht As Worksheet
    lstPlanilhas.Clear
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Principal" Then 'Não exibe a planilha Principal
            lstPlanilhas.AddItem sht.Name
        End If
    Next sht
End Sub
Tags: No tags

4 Responses

Leave a Comment