ExcelBanter - Export Multiple worksheets to text files

Try something like this:

Sub Test()

Dim arr
Dim sh As Worksheet
Dim strFolder As String
Dim strFile As String

strFolder = "C:\"

For Each sh In ThisWorkbook.Worksheets
With sh
arr = Range(.Cells(1), .Cells(120, 1))
strFile = strFolder & sh.Name & ".par"
SaveArrayToText strFile, arr
End With
Next sh

End Sub

Sub SaveArrayToText(ByVal txtFile As String, _
ByRef arr As Variant, _
Optional ByVal LBRow As Long = -1, _
Optional ByVal UBRow As Long = -1, _
Optional ByVal LBCol As Long = -1, _
Optional ByVal UBCol As Long = -1, _
Optional ByRef fieldArr As Variant)

Dim r As Long
Dim c As Long
Dim hFile As Long

If LBRow = -1 Then
LBRow = LBound(arr, 1)
End If

If UBRow = -1 Then
UBRow = UBound(arr, 1)
End If

If LBCol = -1 Then
LBCol = LBound(arr, 2)
End If

If UBCol = -1 Then
UBCol = UBound(arr, 2)
End If

hFile = FreeFile

'Close before reopening in another mode.
'---------------------------------------
On Error Resume Next
Open txtFile For Input As #hFile
Close #hFile

Open txtFile For Output As #hFile

If IsMissing(fieldArr) Then
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next c
Next r
Else
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next c
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next c
Next r
End If

Close #hFile

End Sub

RBS

"Rob Fenwick" wrote in message
...
Has anyone exported from excel multiple worksheets to individual files?
I want to have each file named the contents it's respective worksheet.
Only 1 column of data is to exported column "A". Rows are all the same
in each worksheet.

I would like to use notepad as the application and save the files as
*.par extensions for a diff apps use.

Thank you

Rob

*** Sent via Developersdex http://www.developersdex.com ***