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
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
Ricardo,
Seu erro está em:
Sheets(ANTONIO).Copy Before:=NovoArquivoXLS.Sheets(1)
Altere apenas esta linha, assim:
Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
Abç
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…
Ricardo,
Você baixou o arquivo disponível para download?
Ele funcionou?
Se sim, você está se perdendo na modificação do seu código.
Tente revisá-lo e comparar com o código do artigo.
Abç
—————————————————
Siga-nos no twitter: @exceldoseujeito