Retirar ultima linha em branco de txt criado por VBA

[andre.mousinho]

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.

[andre.mousinho]

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

[Reinaldo]

Sem poder testar, pela falta de modelo/exemplo
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

Por:

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

[andre.mousinho]

Bom dia Reinaldo,

Muito obrigado pelo retorno, porém não deu certo. Vou anexar a planilha para facilitar.

Obrigado novamente.

[Reinaldo]

Seu arquivo está corrompido