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

4 comentários em “Macro para Salvar uma Planilha XLS em TXT”

  1. Reinaldo,
    Estou com problema com está macro o e-mail está sendo enviado normalmente, porem os dados da planilha não está sendo copiado na planilha criada, gostaria da sua ajuda neste processo.
    Sub EnviarEmailPlanilhaEspecifica()
    Dim NovoArquivoXLS As Workbook
    Dim sPlanAEnviar As String
    Dim sExcluirAnexoTemporario As String
    ‘Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc
    sPlanAEnviar = “ANTONIO”
    ‘Cria um novo arquivo excel
    Set NovoArquivoXLS = Application.Workbooks.Add
    ‘Copia a planilha para o novo arquivo criado
    Sheets(ANTONIO).Copy Before:=NovoArquivoXLS.Sheets(1)
    ‘Salva o arquivo
    NovoArquivoXLS.SaveAs ThisWorkbook.Path & “” & sPlanAEnviar & “.xls”
    sExcluirAnexoTemporario = NovoArquivoXLS.FullName
    ‘Envia o email
    NovoArquivoXLS.SendMail “fulano@com.br”, “Titulo”
    ‘Fecha o arquivo novo
    NovoArquivoXLS.Close
    ‘Exclui o arquivo criado apenas para ser enviado.
    Kill sExcluirAnexoTemporario
    End Sub

    Responder
  2. Caro Reinaldo,
    O me intriga é os dados que serão copiados para o novo aquivo são os dados que estão na planilha que contem a macro? Por que se for…cara comigo não está dando certo…. fiz a correção dquele erro…agora só estou com problema para passar os dados da planilha para o novo arquivo…

    Responder

Deixe um comentário