How do I convert each column in Excel into its own .txt file?

[aespinosa]

Hello;

I have a spreadsheet called ManyTXT. Each column provides data (in seconds) for a single person. I have a total of 46 people, so the spreadsheet has 46 columns. I would like to convert each column into its own separate .txt file with the name of the person for whom the column (or .txt file) corresponds to. The names of the individuals are on the first row as follows:

Person1 Person2 Person3 ... Person46
seconds seconds seconds seconds
seconds seconds seconds seconds
seconds seconds seconds seconds
seconds seconds seconds seconds
seconds ...

Can someone please help me get the vba code? I have successfully ran a code that saves each row. I need each column and for the life of me can't seem to alter the code. Any help will be eternally appreciated.
thanks

 

[Danerida]

Right click the sheet tab and click "View Code", then paste this code in the window that opens:

Sub ColumnsToTXT()Dim thisCol, newSht, c, r
Dim ws As Worksheet
Dim pathname As String
Dim DataRange As Range


Set DataRange = Cells(1, 1).Resize(UsedRange.Rows.Count, UsedRange.Columns.Count)


Application.DisplayAlerts = False


For c = 1 To UsedRange.Columns.Count
' Copy the column to a new temp sheet
    r = Cells(100000, c).End(xlUp).Row
    thisCol = Cells(1, c).Resize(r).Value
    newSht = Cells(1, c).Value
'Chech that the sheet doesn't already exist and delete if it does
    On Error Resume Next
    Set ws = Sheets(newSht)
    On Error GoTo 0
    If Not ws Is Nothing Then ws.Delete
'Add the new sheet
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = newSht
    Sheets(newSht).Cells(1, 1).Resize(r).Value = thisCol
' Save the sheet as .txt file
    pathname = "c:\" & newSht & ".txt" 'Change the directory as required
    Sheets(newSht).Copy
'Close the file
    ActiveWorkbook.SaveAs Filename:=newSht, _
        FileFormat:=xlTextWindows, CreateBackup:=False, ConflictResolution:=xlLocalSessionChanges
    ActiveWorkbook.Close
'Delete the redundant sheet
    Worksheets(newSht).Delete
Next c


Application.DisplayAlerts = True


End Sub

Dan

 

[apo]

Hi..

Change sheet name to suit. Text files will be saved in same Folder as your workbook.

[FONT=Courier New][COLOR=#0000FF]Sub[/COLOR][COLOR=#000000] CreateTextFiles[/COLOR][COLOR=#000000]()[/COLOR]
[/FONT]Dim x, i As Long
    x = Sheets("Sheet1").[A1].CurrentRegion
    For i = LBound(x, 2) To UBound(x, 2)
     With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\" & x(1, i) & ".txt", True)
            .writeline Join(Application.Transpose(Application.Index(x, 0, i)), vbCrLf)
    End With
    Next i
    MsgBox "Text Files Saved to: " & ThisWorkbook.Path
[FONT=Courier New][COLOR=#0000FF]End[/COLOR][COLOR=#000000] [/COLOR][COLOR=#0000FF]Sub[/COLOR]
[/FONT]

 

[aespinosa]

Thanks a million to all who helped. I got it!!!!

Adriana

Hi..

Change sheet name to suit. Text files will be saved in same Folder as your workbook.

[FONT=Courier New][COLOR=#0000FF]Sub[/COLOR][COLOR=#000000] CreateTextFiles[/COLOR][COLOR=#000000]()[/COLOR]
[/FONT]Dim x, i As Long
    x = Sheets("Sheet1").[A1].CurrentRegion
    For i = LBound(x, 2) To UBound(x, 2)
     With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\" & x(1, i) & ".txt", True)
            .writeline Join(Application.Transpose(Application.Index(x, 0, i)), vbCrLf)
    End With
    Next i
    MsgBox "Text Files Saved to: " & ThisWorkbook.Path
[FONT=Courier New][COLOR=#0000FF]End[/COLOR][COLOR=#000000] [/COLOR][COLOR=#0000FF]Sub[/COLOR]
[/FONT]