a Macro which saves the cell values of every column of every worksheet into a large text list?

[ablaze]

Hi guys, this is my first post on this forum!

I know this will sound really unsophisticated, but I'm looking for a macro that, when executed, will save the all the cell values of every column of every worksheet into one single .txt list. To make that clear, the text file wouldn't be a table, but simply a list of all the cell values, cell value after cell value.

Basically the macro would do something along these lines:
1. In worksheet 1, go to the first column, grab the cell values of the whole column and put it into the text list.
2. Go to 2nd column, grab all the cell values of the whole column and put it into the text list.
3. Do this until there are no more columns in worksheet 1.
4. Go to the 2nd worksheet and do the same.
5. Do this until there are no more worksheets in the workbook.

Does anyone know how to do this?
The resulting text list doesn't have to look good.

If anyone decides to help me with code, comments in the code are optional but welcome, as I do want to learn VBA & the macro language (I'm totally new to this).

 

[cgcamal]

Hi ablaze, and welcome to the forum.

Try the following macro, if I understand all requirements, then it seems to work.

The macro saves all the columns of every sheet in workbook one after another in a new sheet and deletes
blank rows, after that it saves the new sheet as txt file with name of current workbook in the same path of it.

[COLOR=Navy]Sub [/COLOR]Save_as_TextFile()
[COLOR=Green]'César C. 12/May/2011
'Macro to put each cell in workbook in continuous rows and save as text file
[/COLOR]
Dim LcC As Long
Dim LastCol As Integer

Application.ScreenUpdating = False

Set WF = WorksheetFunction

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ToSave_as_Text"

' 1-) Fill all columns for each sheet in column A in a new sheet named "ToSave_as_Text"
'######################################################################################
Sh = Sheets.Count
NxtR = 1

For s = 1 To Sh - 1
    With Sheets(s).Select
    c = WF.CountA(Cells)
'    cTotal = cTotal + c
     If c > 0 Then
            'Search for any entry, by searching backwards by Columns.
            LastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        End If
    
        For i = 1 To LastCol
        
            CiC = WF.CountA(Columns(i))
        
            If CiC > 0 Then

                    If Not IsEmpty(Cells(1, i)) Then
                        FirstRow = 1
                    Else
                        FirstRow = Cells(1, i).End(xlDown).Row
                    End If
                    
                    LastRow = Cells(65536, i).End(xlUp).Row
                
                    Range(Cells(FirstRow, i), Cells(LastRow, i)).Copy
                    Sheets("ToSave_as_Text").Range("A" & NxtR).PasteSpecial xlValues
                    NxtR = NxtR + LastRow - FirstRow + 1
                    
            End If
        Next i
    End With
Next s

Application.CutCopyMode = False

    
'2-) Procedure to saving as txt file
'###################################################################################
With Sheets("ToSave_as_Text")

    'Deleting blank rows
    On Error Resume Next     ' In case there are no blanks
    .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    ActiveSheet.UsedRange 'Resets UsedRange

    'cTotal1 = WF.CountA(Sheets("ToSave_as_Text").Cells)

    .Columns("A:A").HorizontalAlignment = xlCenter 'Formatting content to center
       
    'Getting the current workbook name (without extension) and path
    ActiveWb = Left(ActiveWorkbook.Name, WF.Search(".", ActiveWorkbook.Name, 1) - 1)
    CurrentPath = ActiveWorkbook.Path

    Application.DisplayAlerts = False 'Disabling Alert prompt
    
    'Saving as txt file
    .SaveAs Filename:=CurrentPath & "\" & ActiveWb & ".txt", FileFormat:= _
        xlUnicodeText, CreateBackup:=False

    Application.DisplayAlerts = True 'Enabling Alert prompt
End With

Worksheets(Sh).Select
Worksheets(Sh).Range("A1").Select

Sheets(1).Select

Application.ScreenUpdating = True
[COLOR=Navy]End Sub[/COLOR]

Hope this helps,

Regards

 

[brettdj]

Another option is to

1) Use a variant array to hold each column of each usedrange in each sheet
2) Write each record to a single column text file using the filescriptingobject

This code produces a txt output of the ActiveWorkbook at
"C:\test\myfile.txt"

Originally written up with full comments at http://www.experts-exchange.com/A_3509.html as a sample showing how to create a CSV File via VBA transposing rows and columns within a selected range

hth

Dave

Const sFilePath = "C:\test\myfile.txt"
Sub CreateCSV_FSO()
    Dim objFSO
    Dim objTF
    Dim ws As Worksheet
    Dim lRow As Long
    Dim lCol As Long
    Dim strTmp As String
    Dim lFnum As Long

    Set objFSO = CreateObject("scripting.filesystemobject")
    Set objTF = objFSO.createtextfile(sFilePath, True, False)
    For Each ws In ActiveWorkbook.Worksheets
        'test that sheet has been used
        Set rng1 = ws.UsedRange
        If Not rng1 Is Nothing Then
            'only multi-cell ranges can be written to a 2D array
            If rng1.Cells.Count > 1 Then
                X = ws.UsedRange.Value2
                For lCol = 1 To UBound(X, 2)
                    For lRow = 1 To UBound(X, 1)
                        objTF.writeline X(lRow, lCol)
                    Next lRow
                Next lCol
            Else
                objTF.writeline ws.UsedRange.Value
            End If
        End If
    Next ws
    objTF.Close
    Set objFSO = Nothing
    MsgBox "Done!", vbOKOnly
End Sub

 

[ablaze]

cgcamal, thank you so much! =)
And thank you brettdj for an alternative!

I just tried both in Excel 2003, they both work perfectly.
As I'm new to this whole world it's really interesting to see how different scripts can be written. : )