Thread: Help exporting columns into multiple text files

Hi,

I found and edit this script below, see if this does what you need. Leith Ross was the person who made the orginal script. But this should get you going in the right direction with some of my edits. Post back any issue's you may have.

Sub CreateTextFile()
  Const ForAppending As Long = 8
  Const DefaultFormat As Long = -2
  Const UnicodeFormat As Long = -1
  Const AsciiFormat As Long = 0
    Dim C As Long, R As Long
    Dim FileName As String
    Dim Filepath As String
    Dim fso As Object
    Dim LastCol As Long
    Dim LastRow As Long
    Dim Rng As Range
    Dim StartCol As Long
    Dim StartRow As Long
    Dim TxtData As String
    Dim TxtFile As Object
    Dim MyName As String
    Dim MyRow As Long
    Dim MyCol As Long
 
 
 
      StartRow = 1
      StartCol = 1
      MyRow = 1
      MyCol = 1
 
        LastCol = Cells(StartRow, Columns.Count).End(xlToLeft).Column
        LastRow = Cells(Rows.Count, StartCol).End(xlUp).Row
 
 
        For C = StartCol To LastCol
 
            MyName = Cells(MyRow, MyCol).Value
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set TxtFile = fso.OpenTextFile("c:\Test\" & MyName & ".txt", ForAppending, DefaultFormat)
          For R = StartRow + 1 To LastRow
 
 
            Set Rng = Range(Cells(StartRow, C), Cells(LastRow, C))
              If WorksheetFunction.CountIf(Rng, "<>*") <> 0 Then
 
                  TxtData = TxtData & Cells(R, C).Value & vbTab
 
              End If
          Next R
 
                TxtFile.WriteLine (TxtData)
                TxtData = ""
                MyCol = MyCol + 1
                TxtFile.Close
                Set fso = Nothing
                Set TxtFile = Nothing
        Next C
 
End Sub

.

Hello vund0,

This macro will create a file for column on the worksheet using the cells in row 1 as the file name. You will need to change the file path to where your files will be stored.

Sub ExportDataToFiles()

  Dim Col As Range
  Dim Data As Variant
  Dim FileName As String
  Dim FilePath As String
  Dim FSO As Object
  Dim Item As Variant
  Dim TextFile As Object
  Dim Wks As Worksheet
  
    FilePath = "C:\Test Folder\"
    
    Set Wks = Worksheets("pplacer_resampled1021")
    Set Rng = Wks.UsedRange
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
      For Each Col In Rng.Columns
        ReDim Data(1 To Col.Rows.Count, 1 To 1)
        FileName = FilePath & Col.Cells(1, 1)
        Data = Col.Offset(1, 0).Resize(Col.Rows.Count - 1, 1).Value
          Set TextFile = FSO.OpenTextFile(FileName, 2, True, False)
            For Each Item In Data
              TextFile.WriteLine Item
            Next Item
          TextFile.Close
      Next Col
      
End Sub

Hello vund0,

You're welcome. Glad to help.

or

Sub snb()
  sq = Sheets(1).Cells(1).CurrentRegion
  For j = 1 To ubound(sq,2)
    Open "E:\OF\" & sq(1, j) & ".txt" For Output As #1
      Print #1, Join(Application.Transpose(Application.Index(sq, , j)), vbCrLf)
    Close
  Next
End Sub

If you go for speed: no need to load an extra library, nor to produce a new instance of an object.
Open, print & Close are VBA-commands, that are resident in memory.
The code has only 1 reading instruction.
The writing instructions are also diminished to a minimum (1 per column).