An alternative that implements a reusable routine to write text
files...

Option Explicit

Sub ExportData()
Dim vData, vFilenames, sText$, n&, lNumRows&, lNumCols&
Const sPath$ = "D:\Test\"

'Get the data area
With ActiveSheet
lNumRows = .Cells(.Rows.Count, 1).End(xlUp).Row
lNumCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
vFilenames = .Cells(1, 1).Resize(lNumRows)
vData = .Cells(1, 2).Resize(lNumRows, lNumCols - 1)
End With

'Write the data to file
For n = 1 To lNumRows
WriteTextFile Join(Application.Index(vData, n, 0), vbCrLf), sPath &
vFilenames(n, 1) & ".txt"
Next 'n
End Sub

Sub WriteTextFile(TextOut$, Filename$, _
Optional AppendMode As Boolean = False)
' Reusable procedure that Writes/Overwrites or Appends
' large amounts of data to a Text file in one single step.
' **Does not create a blank line at the end of the file**
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & TextOut;
Else
Open Filename For Output As #iNum: Print #iNum, TextOut;
End If

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFile()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion