VBA: Export more than one column to txt

Question

I'm trying to export several columns of data in excel - with blank cells in them - to a single one - without blanks - into a .txt file. So far, I have assembled some pieces of code and I can export ONE column with success. What I'm hoping to do is to copy/paste one column below the one before and so on into the .txt without blanks.

Private Sub CommandButton2_Click()
Dim r As Range, c As Range, rng As Range
Dim sTemp As String
Dim UnusedColumn As Range
Dim Filename As String

Filename = ActiveWorkbook.Path & "\xxx.txt"
Open Filename For Output As #1
Set rng = Range("A2:A1000")

'Find a column with nothing in it
  Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 15)

'Create temporary calculation column to determine which cells to select (marked by an X)
  Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

'Make Selection
  Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select

'Remove Temporary Blank Caluclations
  UnusedColumn.Clear

For Each r In Selection
    sTemp = ""
    For Each c In r.Cells
        sTemp = sTemp & c.Text & Chr(9)
    Next c

    'Get rid of trailing tabs
    While Right(sTemp, 1) = Chr(9)
        sTemp = Left(sTemp, Len(sTemp) - 1)
    Wend
    Print #1, sTemp
Next r
Close #1
End Sub

There's some instructions in there to automatically select non-blank cells and to export each row without quotation marks.

Here's how the .txt looks like with the original code (one column): http://i.stack.imgur.com/DiB33.jpg

And here's how the columns look like: http://i.stack.imgur.com/9Tn3m.jpg

Sorry for the unpolished english and code. Thanks in advance!

Answer 1

When you iterate over an array using a For Each Loop the VBA iterates each element by columns (all the elements in the 1st column, then all the elements in the second column...etc.).

It took 2.38 Second to write 10,000 rows x 255 columns with %50 populated with 14 Digit numbers stored as text

Sub WriteToValues()
    Dim Start: Start = Timer
    Dim Data, v
    Dim FileName As String
    FileName = ActiveWorkbook.Path & "\xxx.txt"

    Data = ActiveSheet.UsedRange.Value2

    Open FileName For Output As #1

    For Each v In Data
        If v <> vbNullString Then Print #1, CStr(v)
    Next

    Close #1
    Debug.Print Timer - Start
End Sub