A macro for output an excel file to text file

[cmk_excel]

Hi every one,

I have an Excel file and it has some data in the following format:

ABC 2 13328001234 8 3 0 0 1 0 1 0 0
EFG 2 13328900000 8 3 0 0 1 0 1 0 0
XYZ 2 13330192020 8 3 0 0 1 0 1 0 0

I want to export such Excel file to a text file with the data above, and the first column of the Worksheet will be the text file's name, and each text file's content may like:

2
13328001234
8
3
0
0
1
0
1
0
0

What I should do with Macro?

Thanks for your attention.


Joseph Chan

[Leith Ross]

Hello J. Chan,

Here is a macro to create the text files from the worksheet. The file name is taken from column "A". The data is read from column "B" on. The macro determines the end of the data and the last file name on the worksheet. Copy and Paste this code into a Standard VBA Project Module. You can then run the macro. The macro will prompt you for the disk and directory where the files will be saved.

Running the Macro Manually:

1) Select the Worksheet you wish to use the macro on.
2) Press Alt + F8 together to bring up the macro list.
3) Select the macro from the list and Click Run or press Enter

Calling the Macro From Code:

Call CreateFiles
_________________________________________________________________

Public Sub CreateFiles()

Dim RetVal
Dim FF As Integer
Dim I As Long
Dim J As Long

Dim FileName As String
Dim FilePath As String

Dim Wks As Worksheet

On Error GoTo FileError

Set Wks = ActiveSheet
FF = FreeFile
StartingCell = "A1"

FilePath = InputBox("Enter the Disk and Directory where the Text Files will be Saved.")
If FilePath = "" Then Exit Sub

With Wks.Range(StartingCell)
StartColumn = .Column
StartRow = .Row
End With

EndColumn = Wks.Cells(StartRow, Columns.Count).End(xlToLeft).Column
EndRow = Wks.Cells(Rows.Count, StartColumn).End(xlUp).Row

For I = StartRow To EndRow
FileName = FilePath & Wks.Cells(I, StartColumn).Value & ".txt"
Open FileName For Output As #FF
For J = StartColumn + 1 To EndColumn
Write #FF, Wks.Cells(I, J).Value
Next J
Close #FF
Next I

Exit Sub

FileError:
Msg = "Error " & Err.Number & vbCrLf & Err.Description
RetVal = MsgBox(Msg, vbCritical + vbOKOnly)
Err = 0

End Sub
_________________________________________________________________

If you have any questions or problems with the macro, you can contact me via e-mail at [email protected].

Hope this is what your looking for,
Leith Ross