Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Retirar ultima linha em branco de txt criado por VBA
-
- Acabou de chegar
- Mensagens: 8
- Registrado em: Ter Jan 22, 2019 11:56 am
Retirar ultima linha em branco de txt criado por VBA
Amigos boa noite,
Estou com um problema ao exportar um arquivo para .txt. Está tudo perfeito, porém fica uma linha vazia no .txt que é gerado, aí tenho que abrir ele e excluir com um backspace a última linha em branco. Alguém saberia me ajudar?
Obrigado.
Estou com um problema ao exportar um arquivo para .txt. Está tudo perfeito, porém fica uma linha vazia no .txt que é gerado, aí tenho que abrir ele e excluir com um backspace a última linha em branco. Alguém saberia me ajudar?
Obrigado.
-
- Acabou de chegar
- Mensagens: 8
- Registrado em: Ter Jan 22, 2019 11:56 am
Re: Retirar ultima linha em branco de txt criado por VBA
Abaixo o código que estou utilizando:
Sub Salvar3()
Dim Nome As String
Dim Quantdados As Long
Dim Linha As Long
Quantdados = Sheets("Plan1").Range("A1000000").End(xlUp).Row
Linha = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
While Linha < Quantdados + 1
Sheets("Plan1").Select
Nome = Range("A" & Linha).Value
Sheets("Plan2").Select
UltimaCel = Range("A1000000").End(xlUp).Row + 1
Range("A" & UltimaCel).Value = Nome
Linha = Linha + 1
Wend
Sheets("Plan1").Select
On Error GoTo Erro
Dim Arquivo As Workbook
Dim Plan As String
Plan = "Plan2"
Set Arquivo = Application.Workbooks.Add
ThisWorkbook.Sheets(Plan).Copy Before:=Arquivo.Sheets(1)
Arquivo.SaveAs ThisWorkbook.Path & "\" & "emis" & "_" & ActiveSheet.Range("A1048576") & "_" & ActiveSheet.Range("B1048576") & "_" & "993" & ".txt", FileFormat:=xlTextPrinter, _
CreateBackup:=False
Arquivo.Close
MsgBox "Copia realizada com sucesso!", vbInformation, "CÓPIA"
Sheets("Plan2").Select
Range("A1:A1048576").Value = ""
Sheets("Plan1").Select
Application.Calculation = xlCalculationAutomatic
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "COPIAR"
End Sub
Sub Salvar3()
Dim Nome As String
Dim Quantdados As Long
Dim Linha As Long
Quantdados = Sheets("Plan1").Range("A1000000").End(xlUp).Row
Linha = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
While Linha < Quantdados + 1
Sheets("Plan1").Select
Nome = Range("A" & Linha).Value
Sheets("Plan2").Select
UltimaCel = Range("A1000000").End(xlUp).Row + 1
Range("A" & UltimaCel).Value = Nome
Linha = Linha + 1
Wend
Sheets("Plan1").Select
On Error GoTo Erro
Dim Arquivo As Workbook
Dim Plan As String
Plan = "Plan2"
Set Arquivo = Application.Workbooks.Add
ThisWorkbook.Sheets(Plan).Copy Before:=Arquivo.Sheets(1)
Arquivo.SaveAs ThisWorkbook.Path & "\" & "emis" & "_" & ActiveSheet.Range("A1048576") & "_" & ActiveSheet.Range("B1048576") & "_" & "993" & ".txt", FileFormat:=xlTextPrinter, _
CreateBackup:=False
Arquivo.Close
MsgBox "Copia realizada com sucesso!", vbInformation, "CÓPIA"
Sheets("Plan2").Select
Range("A1:A1048576").Value = ""
Sheets("Plan1").Select
Application.Calculation = xlCalculationAutomatic
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "COPIAR"
End Sub
- Reinaldo
- Jedi
- Mensagens: 1537
- Registrado em: Sex Ago 01, 2014 4:09 pm
- Localização: Garça - SP / SCS - SP
Re: Retirar ultima linha em branco de txt criado por VBA
Sem poder testar, pela falta de modelo/exemplo
Experimente:
suBstitua o trecho:
Por:
Experimente:
suBstitua o trecho:
Código: Selecionar todos
Dim Nome As String
Dim Quantdados As Long
Dim Linha As Long
Quantdados = Sheets("Plan1").Range("A1000000").End(xlUp).Row
Linha = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
While Linha < Quantdados + 1
Sheets("Plan1").Select
Nome = Range("A" & Linha).Value
Sheets("Plan2").Select
UltimaCel = Range("A1000000").End(xlUp).Row + 1
Range("A" & UltimaCel).Value = Nome
Linha = Linha + 1
Wend
Sheets("Plan1").Select
Código: Selecionar todos
Dim Quantdados As Long, UltimaCel As Long
Dim Linha As Long
Quantdados = Sheets("Plan1").Range("A1000000").End(xlUp).Row
UltimaCel = Sheets("Plan2").Range("A1000000").End(xlUp).Row + 1
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Sheets("Plan1")
For Linha = 2 To Quantdados
Sheets("Plan2").Range("A" & UltimaCel).Value = .Range("A" & Linha).Value
UltimaCel = UltimaCel + 1
Next
End With
-
- Acabou de chegar
- Mensagens: 8
- Registrado em: Ter Jan 22, 2019 11:56 am
Re: Retirar ultima linha em branco de txt criado por VBA
Bom dia Reinaldo,
Muito obrigado pelo retorno, porém não deu certo. Vou anexar a planilha para facilitar.
Obrigado novamente.
Muito obrigado pelo retorno, porém não deu certo. Vou anexar a planilha para facilitar.
Obrigado novamente.
- Anexos
-
- Emissao Apolice.xlsx.rar
- (2.5 MiB) Baixado 211 vezes