Macro for exporting text files from Excel file wit

Question

I need a macro that will export a worksheet in an Excel file so that they are comma separated text files that look like this:

field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field, field

I have the following macro that runs on a file BUT need it to do the following:

1) It should run on the active open worksheet in an Excel file with multiple worksheets. 2) Should prompt the user to save the new text file with a unique name. 3) Places the text file either on the desktop or in a designated folder.

Here's the macro:

Sub WriteCSVFile()

Dim ws As Worksheet
Dim fName As String, Txt1 As String
Dim fRow As Long, lRow As Long, Rw As Long
Dim Col As Long

Set ws = Sheets("Sheet1")
fName = "C:\yourpath\yourfilename.csv"
fRow = 2
Col = 2
Txt1 = ""

    With ws
        lRow = .Cells(Rows.Count, Col).End(xlUp).Row

        Open fName For Output As #1

            For Rw = fRow To lRow
                Txt1 = .Range(.Cells(Rw, Col), .Cells(Rw, Col))
                    If Rw = lRow Then
                        Print #1, Txt1
                    Else
                        Print #1, Txt1 & ", ";
                    End If
            Next Rw

        Close #1

        MsgBox ".csv file exported"

    End With
End Sub

The problem with the above is that I have to modify the macro for each worksheet. I would like something that can run without modification on any open worksheet.

Answer 1

And with acknowledgements to Dave, with a couple of embellishments. Will allow you to open a source file and iterate through all its worksheets before closing it. The .csv files have a filename the same as the worksheet Tab name (so no user prompting required). The code writes a log entry of the 'exports' to a Sheet called 'Log' in ThisWorkbook.

Add your own 'fOutPath' in this code and add a sheet called "Log" to the file in which you will store/run this code. Assumes the source data is in the same place in each worksheet, in a single column starting at (fRow,Col) currently set at "B2".

Sub WriteCSVFile2()

Dim wb As Workbook
Dim ws As Worksheet
Dim fd As Object
Dim fOutName As String, fInName As String
Dim fOutPath As String, Txt1 As String
Dim fRow As Long, lRow As Long, Rw As Long
Dim Col As Long, logNextRow As Long, logCol As Long

fOutPath = yourpath
logCol = 1  'col A

'Open file select dialog
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.AllowMultiSelect = False
fd.Show
fInName = fd.SelectedItems(1)

    If Not fInName = "" Then
        'Open the source data file; need a check if this wbook is already open
        Set wb = Workbooks.Open(fInName)

            'Iterate through the sheets collection to write data to .csv file(s)
            For Each ws In Worksheets
                'Set csv output file name as ws Tab name
                fOutName = fOutPath & ws.Name & ".csv"
                'You could 'detect' fRow and Col from the worksheet?
                fRow = 2
                Col = 2
                Txt1 = ""
                    'Write csv file for this sheet
                    With ws
                        lRow = .Cells(Rows.Count, Col).End(xlUp).Row

                        Open fOutName For Output As #1

                            For Rw = fRow To lRow
                                Txt1 = .Range(.Cells(Rw, Col), .Cells(Rw, Col))
                                    If Rw = lRow Then
                                        Print #1, Txt1
                                    Else
                                        Print #1, Txt1 & ", ";
                                    End If
                            Next Rw

                        Close #1
                    End With

                    'Write an Output Log to a Sheet called "Log"
                    With ThisWorkbook.Sheets("Log")
                        logNextRow = .Cells(.Rows.Count, logCol).End(xlUp).Row + 1
                        .Cells(logNextRow, logCol).Value = "From: " & wb.Name
                        .Cells(logNextRow, logCol).Offset(0, 1).Value = _
                        " To: " & fOutPath & ws.Name & ".csv"
                        .Cells(logNextRow, logCol).Offset(0, 2).Value = Now()
                        .Range(.Cells(logNextRow, logCol), .Cells(logNextRow, logCol).Offset(0, 2)).Columns.AutoFit
                    End With

            Next ws

        'Close source data workbook
        wb.Close SaveChanges:=False

        'Confirm export to user
        MsgBox ".csv file(s) exported"

    End If

End Sub

Answer 2

Try this:

Sub WriteCSVFile()

Dim ws As Worksheet
Dim fName As String, Txt1 As String
Dim fRow As Long, lRow As Long, Rw As Long
Dim Col As Long

For Each ws In ActiveWorkbook.Sheets
    fName = Application.GetSaveAsFilename("C:\yourpath\" & ws.Name & ".csv")
    fRow = 2
    Col = 2
    Txt1 = ""
    With ws
        lRow = .Cells(Rows.Count, Col).End(xlUp).Row

        Open fName For Output As #1

            For Rw = fRow To lRow
                Txt1 = .Range(.Cells(Rw, Col), .Cells(Rw, Col))
                    If Rw = lRow Then
                        Print #1, Txt1
                    Else
                        Print #1, Txt1 & ", ";
                    End If
            Next Rw

        Close #1

        MsgBox ".csv file exported"

    End With
Next ws
End Sub

It loops through the sheets in your workbook and opens the GetSaveAsFileName dialog box with the current sheet name as the default.