Home > front end >  Hi, how con I export a txt file from an excel sheet without having a blank line at the end?
Hi, how con I export a txt file from an excel sheet without having a blank line at the end?

Time:04-10

When I export the sheet as txt it generates an empy line at the end, in the next link is a screenshot of what it looks like incorrect txt file, this next link is a screenshot of what I need it to look like correct txt file

I'm currently using this code to detect the used range and only export that, its neccesary to have the workbook with the data you want to copy open

Sub export_range_txt()

    
    Workbooks.Add
    y = ActiveWorkbook.Name
    'insert the name of the workbook were data is been copied and create  this sub there
    Windows("original.xlsm").Activate 
    ActiveSheet.Activate
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row 
    Range("A1:Y" & LastRow).Copy
    Windows(y).Activate
    ActiveSheet.Activate
    Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      
           
        
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
   'change path to desired location of the txt file
        "path\test.txt", FileFormat:=xlText, _
    CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True

End Sub

CodePudding user response:

The following function will export a range to a text file without a blank line at the end.

Function exportRgToTxt(rg As Range, filename As String)

    ' use a semicolon as a column separator, adjust accordingly or use a parameter
    Const SEPARATOR = ";"

    Dim i As Long, j As Long
    Dim vdat As Variant, vRow As Variant
        
    ' Placing the values of the range into an array
    vdat = rg.Value

    Dim txtFile As Long
    txtFile = FreeFile
    Open filename For Output As txtFile
        
    ' Write each row of the range to the text file but the last one
    For i = LBound(vdat, 1) To UBound(vdat, 1) - 1
        vRow = Application.WorksheetFunction.Index(vdat, i, 0)  ' Get the i-th row of the array
        vRow = Join(vRow, SEPARATOR)
        Print #txtFile, vRow   ' This will add a CRLF at the end of the line
    Next i
    
    ' Write Last row without an CRLF
    vRow = Application.WorksheetFunction.Index(vdat, UBound(vdat, 1), 0)
    vRow = Join(vRow, SEPARATOR)
    Print #txtFile, vRow; ' the semicolon will avoid the CRLF at the end of the file
    Close txtFile

End Function

Be aware, the function will fail in case the range contains a single cell only. One could adjust it but I leave that to the reader.

That's how you can test it

Sub testit()
    exportRgToTxt Range("A1").CurrentRegion, "D:\tmp\abc.txt"
End Sub

Further reading on the Print Statement. Especially the charpos parameter is the one we need here

charpos
Specifies the insertion point for the next character. Use a semicolon to position the insertion point immediately after the last character displayed. Use Tab(n) to position the insertion point to an absolute column number. Use Tab with no argument to position the insertion point at the beginning of the next print zone. If charpos is omitted, the next character is printed on the next line.

See below how one could use the function in the OP's code

Sub export_range_txt()
    
    Workbooks.Add
    y = ActiveWorkbook.Name
    'insert the name of the workbook were data is been copied and create  this sub there
    Windows("original.xlsm").Activate
    ActiveSheet.Activate
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    
    'Range("A1:Y" & LastRow).Copy  ' this line is not needed any longer
    
    ' Here you could use the exportRgToTxt instead
    exportRgToTxt Range("A1:Y" & LastRow), "<your file name>"
    
    
    ' the remaining code is not neccessary
'    Windows(y).Activate
'    ActiveSheet.Activate
'    Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'
'
'
'    Application.DisplayAlerts = False
'    ActiveWorkbook.SaveAs Filename:= _
'   'change path to desired location of the txt file
'        "path\test.txt", FileFormat:=xlText, _
'    CreateBackup:=False
'    ActiveWindow.Close
'    Application.DisplayAlerts = True

End Sub
  • Related