Bom dia!!

Seria bom que ao postar a mesma dúvida em mais de um fórum indicar a postagem!!

http://www.expertaccess.com.br/forumnew ... ?TID=27168

Att

ok, valeu pelo esclarecimento
aguardando ajuda!

Giba,
sendo sincero não havia visto esse tipo de exportação para txt; achei muito interessante,
porem nos testes que fiz exportou apenas a parte preenchida (com valores).

até ai tudo os dados foram exportados numa boa, no entanto observei que o prompt do notepad ficava abaixo da ultima linha, observei no anexo que vc postou que o prompt fica na ultima linha no entanto não ocorreu na minha exportação, vc mudou algo no codigo?

Não alterei nada, o que pode estar acontecendo é que, se em sua planilha houver muitas inclusões e esclusões de linhas/colunas, seu usedrange (o numero de linhas/colunas que o excel considera com dados) seja maior que o "real".
Posicione o cursor em a1; depois precione a tecla ctrl + End e veja se o cursor vai para a ultima linha/coluna preenchida, ou mais alem?

o prompt parou na linha E65536

Essa é a ultima preenchida?
Se não for experimente deletar as linhas/colunas indesejadas.
Talvez o codigo abaixo o auxilie:

Option Explicit
Sub SHRINK_EXCEL_FILE_SIZE()

Dim WSheet As Worksheet
Dim CSheet As String 'New Worksheet
Dim OSheet As String 'Old WorkSheet
Dim Col As Long
Dim ECol As Long 'Last Column
Dim lRow As Long
Dim BRow As Long 'Last Row
Dim Pic As Object

For Each WSheet In Worksheets
WSheet.Activate
'Put the sheets in a variable to make it easy to go back and forth
CSheet = WSheet.Name
'Rename the sheet to its name with _Delete at the end
OSheet = CSheet & "_Delete"
WSheet.Name = OSheet
'Add a new sheet and call it the original sheets name
Sheets.Add
ActiveSheet.Name = CSheet
Sheets(OSheet).Activate
'Find the bottom cell of data on each column and find the further row
For Col = 1 To Columns.Count 'Find the actual last bottom row
If Cells(Rows.Count, Col).End(xlUp).Row > BRow Then
BRow = Cells(Rows.Count, Col).End(xlUp).Row
End If
Next

'Find the end cell of data on each row that has data and find the furthest one
For lRow = 1 To BRow 'Find the actual last right column
If Cells(lRow, Columns.Count).End(xlToLeft).Column > ECol Then
ECol = Cells(lRow, Columns.Count).End(xlToLeft).Column
End If
Next

'Copy the REAL set of data
Range(Cells(1, 1), Cells(BRow, ECol)).Copy
Sheets(CSheet).Activate
'Paste Every Thing
Range("A1").PasteSpecial xlPasteAll
'Paste Column Widths
Range("A1").PasteSpecial xlPasteColumnWidths

Sheets(OSheet).Activate
For Each Pic In ActiveSheet.Pictures
Pic.Copy
Sheets(CSheet).Paste
Sheets(CSheet).Pictures(Pic.Index).Top = Pic.Top
Sheets(CSheet).Pictures(Pic.Index).Left = Pic.Left
Next Pic
Sheets(CSheet).Activate

'Reset the variable for the next sheet
BRow = 0
ECol = 0
Next WSheet

' Since, Excel will automatically replace the sheet references for you on your formulas,
' the below part puts them back.
' This is done with a simple replace, replacing _Delete with nothing
For Each WSheet In Worksheets
WSheet.Activate
Cells.Replace "_Delete", ""
Next WSheet
'Roll through the sheets and delete the original fat sheets
For Each WSheet In Worksheets
If Not Len(Replace(WSheet.Name, "_Delete", "")) = Len(WSheet.Name) Then
Application.DisplayAlerts = False
WSheet.Delete
Application.DisplayAlerts = True
End If
Next
End Sub

não é a ultima preenchida, na verdade ela está vazia
exclui as linhas indesejadas e continua o cursor na linha após os dados mesmo não tendo valores

estive pensando o seguinte, teria como encaixar na rotina uma seleção apenas das celulas preenchidas e depois exportar apenas as selecionada?

coisa do tipo :

Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy

ou seria

Selection.End(xlDown).Select

alguma dica?

Experimente em seu codigo modificado:

Sub Exportar()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

template_file = ActiveWorkbook.FullName

fileSaveName = Application.GetSaveAsFilename(InitialFileName:="C:username" + _
                                VBA.Strings.Format(Now, "mmddyyyy") + ".txt", fileFilter:="Text Files (*.txt), *.txt")

If fileSaveName = False Then
    Exit Sub
End If

'cria uma cópia da pasta de trabalho atual da planilha atual
Dim newBook As Workbook
Dim plan As Worksheet
Dim lastRow As Integer
Dim lastColum As Integer
Dim Old As String
'Guarda nome do arquivo atual
Old = ThisWorkbook.Name
'Cria um novo arquivo
Set newBook = Workbooks.Add

Workbooks(Old).Activate
'Seleciona a range com dados
lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
lastColum = ActiveSheet.Cells(lastRow, Cells.Columns.Count).End(xlToLeft).Column
ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastColum)).Select
'Copia a range
Selection.Copy
'Seleciona o novo arquivo
newBook.Activate
''Salca os dados no novo arquivo
Sheets(1).Range("A1").Select
ActiveSheet.Paste

'exclui as demais planilhas
For Each plan In newBook.Sheets
    If plan.Name <> ActiveSheet.Name Then
        newBook.Worksheets(plan.Index).Delete
    End If
Next

newBook.SaveAs Filename:= _
                        fileSaveName, FileFormat:=xlTextWindows, CreateBackup:=False

'fecha a pasta de trabalho gerada
newBook.Close SaveChanges:=True
Set newBook = Nothing
Application.ScreenUpdating = True
MsgBox "O arquivo foi exportado com sucesso! ", vbInformation, "Exportar arquivos"
Range("A1").Select
End Sub

desculpe a demora em responder coisas de final de semana,
estou testando e retorno em breve

testei a rotina e continua uma linha no fina do txt, achei que fosse uma falha na minha planilha então criei outra e refiz o teste
no entanto deu na mesma! teria um local onde eu possa disponibilizar a planilha em questão para uma melhor avaliação?

Voce pode anexar o seu arquivo (compactado Zip ou rar) aqui mesmo no forum, veja como em viewtopic.php?f=7&t=3841
ou em algum site tipo sendspace ou 4shared e disponibilizar no post o link gerado