vba - export file txt TAB delimited and erase empty rows
Post date: Feb 3, 2011 11:30:03 PM
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