excel vba‎ > ‎

vba - export file txt TAB delimited and erase empty rows

posted Feb 3, 2011, 3:30 PM by Roberto Felicini

Sub export_TXT()

Application.DisplayAlerts = False
ActiveSheet.UsedRange.Select
Selection.NumberFormat = "@"


'===============================================
' clear the empty cells
L1 = ActiveSheet.Cells(65536, 1).End(xlUp).Row
L2 = Cells.SpecialCells(xlCellTypeLastCell).Row
Rows(L2).Select
L3 = L1 + 1
Do Until L1 = L2
Range(Cells(L3, 1), Cells(L2, 1)).EntireRow.Select
Selection.EntireRow.Delete
Range("a1").Select
ActiveSheet.UsedRange.Select
L2 = Cells.SpecialCells(xlCellTypeLastCell).Row
Loop
'===============================================
    file1 = ActiveWorkbook.Name
    Name = ActiveSheet.Name
    company = Range("c2").Value
    Condition = Range("a2").Value
    Table = Range("b2").Value
   
    Name3 = "pricing_" & Condition
    'Name = ActiveSheet.Name
    ActiveSheet.Copy
   InitialFileName = "C:\" & Name3 & "_" & Table & "_" & company & "_" & VBA.Strings.Format(Now, "yyyymmdd_hhnnss") + ".txt"

'  replace txt
    Dim i As Long, txt As String
        With ActiveSheet.UsedRange
    For i = 1 To .Rows.Count
        txt = txt & vbCrLf & Join$(Application.Transpose(Application.Transpose(.Rows(i).Value)), vbTab)
    Next
        End With
        Open Replace(ActiveWorkbook.Path & InitialFileName, ".xls", ".txt") For Output As #1
        Print #1, Mid$(txt, Len(vbCrLf) + 1)
    Close #1

' *************************
  
ActiveWorkbook.Close False
    Workbooks(file1).Activate
   
    Range("a1").Select
    ActiveWorkbook.Save
        filetxt = InitialFileName
    MsgBox "Your file has been successfully created at: " & vbCr & vbCr & filetxt

Application.DisplayAlerts = True

End Sub

Comments