Create multiple text files using multiple Excel worksheets using VBA

Question

So what I am trying to do is create a text file from each worksheet in my excel file, exporting only column D.

So far I have a macro which exports column D, but only on the active worksheet.

Here is my current macro:

 Private Sub CommandButton21_Click()

    Dim userName As Variant
    userName = InputBox("Enter your six character user ID")
    Dim userNamePath As String
    userNamePath = "C:\Users\" & userName & "\Desktop\Device Configurations\"
    MkDir userNamePath
    Dim filename As String, lineText As String
    Dim myrng As Range, i, j

    filename = userNamePath & "test.txt"

    Open filename For Output As #1

    Set myrng = Range("C1:C5, D1:D5")

    For i = 1 To myrng.Rows.Count

        For j = 1 To myrng.Columns.Count
            lineText = IIf(j = 1, "", lineText & ",") & myrng.Cells(i, j)
        Next j
        Print #1, lineText
    Next i

    Close #1
End Sub

So I am creating a folder on the users Desktop titled "Device configurations" and am dropping the text files into this directory. The text file is called "test" for testing purposes. I would like to export these text files with the name of their respective worksheets.

So for example I would like to export Sheets 1,2,3,4, and 5 but only column D from each worksheet, and each needs to have its own text file. I would like to accomplish this with a single macro click.

Answer 1

You just needed to add a loop around your code, if I understand correctly:

Sub t()
Dim ws      As Worksheet

Dim userName As Variant
userName = InputBox("Enter your six character user ID")
Dim userNamePath As String
userNamePath = "C:\Users\" & userName & "\Desktop\Device Configurations\"
MkDir userNamePath
Dim filename As String, lineText As String
Dim myrng   As Range, i, j

For Each ws In ActiveWorkbook.Sheets
    With ws
        filename = userNamePath & .Name & " - test.txt"    ' to add the worksheet name to the text file

        Open filename For Output As #1

        Set myrng = .Range("C1:C5, D1:D5")

        For i = 1 To myrng.Rows.Count

            For j = 1 To myrng.Columns.Count
                lineText = IIf(j = 1, "", lineText & ",") & myrng.Cells(i, j)
            Next j
            Print #1, lineText
        Next i

        Close #1
    End With                 'ws
Next ws

End Sub