Espacios En blanco con macros al Generar TXT

Tengo mi Formulario De Generar TXT el cual esta coformado de 3 partes
1.- Head(Encabezado, que lo crea en el formulario)(ya esta la creación del Encabezado)
2.- Body(Lo copia de otro Libro(ya esta el copiado)
3.- Trial(También lo crea del Formulario y va en la parte Final del Archivo de Texto)
Ya tengo la 3 partes me las Genera en un libro(consolidado) y También ya me crea mi Archivo de Texto(con ruta fija) pero quiero que al Generar el Archivo de Text no copie las Lineas en blanco, aquí les dejo la Estructura.
1. El archivo debe contener un solo header y debe estar en la línea uno.(LISTO)
2. Debe contener por lo menos una línea en el body(detalle)
(Botón de Copiar ya esta)
3. El archivo debe contener un solo Trailer y debe estar en la última línea.
(Ya lo tengo se adjunta después del body)
Nota. Es importante validar que después del Trailer no se agregue ninguna línea más ni siquiera en blanco
(este es el problema que tengo cuando Genero el TXT al final me deja una linea en blanco y no se porque)
No se si sea el código.
Nota. No debe de haber líneas en blanco. (este es mi problema)
Mi problema es que al generar mi TXT al final del trail me deja un ENTER y quisiera sabe si hay modo de eliminarlo o si alguien tiene algún código de generar TXT que pueda probar
Les dejo el archivo.
[url=https://www.dropbox.com/s/sl1q2j2b1n8n7hg/GenerarTxt.zip]
Private Sub btnGenerarTxt_Click()
Dim Ruta As String, Archivo As String
Ruta = "C:\Users\OPENROAD\Desktop\Macros Excel\"
Archivo = "IGSSGRAL.WS418690.TI2012.X0529.EZ3.PEX.txt"
With Workbooks.Add
ThisWorkbook.Worksheets("Consolidado").Range("A1:a65536").Copy
With .Worksheets(1)
.Range("a1").PasteSpecial xlPasteValues
.Rows("1:5").EntireRow.Delete
End With
.SaveAs Filename:=Ruta & Archivo, FileFormat:=xlTextWindows
.Close False
End With
LimpiarFormulario
MsgBox ("Archivo Creado en: " & Ruta)
End Sub
[/url]