Excel - series de excel a archivos txt

Public Sub Test()

Dim FilePath As String

FilePath = "E:\tmp\lwp\"

Dim cSheet As Worksheet

Set cSheet = Application.ActiveWorkbook.ActiveSheet

Dim R As Range

Dim currentRange As Variant

Dim FileName As String

Dim LastFileName As String

Dim fFile As Integer

fFile = freeFile

LastFileName = ""

FileName = ""

For Each currentRange In cSheet.Range("A:A")

    Set R = currentRange

    If R.Value = "" Then Exit For

    FileName = R.Value & ".txt"

    Dim valueTW

    If FileName <> LastFileName Then

            Close fFile

            Open FilePath & FileName For Output Shared As #fFile

            valueTW = cSheet.Cells(R.Row, R.Column + 1).Value

            Print #fFile, valueTW

    Else

            valueTW = cSheet.Cells(R.Row, R.Column + 1).Value

            Print #fFile, valueTW

    End If

    LastFileName = FileName

Next

Close fFile

End Sub