Excel - Macro para crear archivos de txt por cada hoja del excel

Dim fsT As Object

Set fsT = CreateObject("ADODB.Stream")

fsT.Type = 2 'Especifica el tipo de dato a guardar el 2 para guardar TEXTO

fsT.Charset = "utf-8" 'Con esto le especificas la codificación que en tu caso es UTF-8

fsT.Open 'Abres el buffer del fichero para escribir

fsT.WriteText "Caracteres especiales: äöüß" 'Seguramente esto tendra que estar en bucle para ir vaciando el contenido de las hojas.

fsT.SaveToFile sFileName, 2 'Guardas el archivo a disco, el nombre eslo que has ido tomando anteriormente.

Public Sub GeneraTXTs()

    Dim doLoop, doSubLoop         As Boolean

    Dim rowAct, rowSubAct, colsTo, iCol As Integer

    Dim sheetTo, fileName, line, concat As String

    Dim fsT                       As Object

    doLoop = True

    rowAct = 2

    Do While doLoop

        'Reposiciono a la Hoja de Control

        Sheets("Indice").Select

        'Controlo que haya datos por procesar

        If Range("D" & rowAct).Value <> "" And Range("E" & rowAct).Value <> "" Then

            sheetTo = Range("D" & rowAct).Value

            fileName = Range("E" & rowAct).Value

            colsTo = Range("F" & rowAct).Value

            'Reposiciono a la Hoja que sera exportada

            Sheets(sheetTo).Select

            doSubLoop = True

            rowSubAct = 1

            Set fsT = CreateObject("ADODB.Stream")

            fsT.Type = 2 'Especifica el tipo de dato a guardar el 2 para guardar TEXTO

            fsT.Charset = "utf-8" 'Con esto le especificas la codificación que en tu caso es UTF-8

            fsT.Open 'Abres el buffer del fichero para escribir

            Do While doSubLoop

                'Valido que exista dato cuando menos en la primer columna...

                'Aqui habria que ver si requiere mas validaciones

                If Range("A" & rowSubAct).Value <> "" Then

                    'Loop para recuperar columnas

                    concat = ""

                    line = ""

                    For iCol = 1 To colsTo

                        line = line & concat & Range(Chr(64 + iCol) & rowSubAct).Value

                        concat = ";"

                    Next iCol

                    fsT.WriteText line & vbCrLf

                Else

                    doSubLoop = False

                End If

                rowSubAct = rowSubAct + 1

            Loop

            fsT.SaveToFile fileName, 2 'Guardas el archivo a disco, el nombre eslo que has ido tomando anteriormente.

        Else

            doLoop = False

        End If

        rowAct = rowAct + 1

    Loop

End Sub