1行単位のデータをテキストファイルに保存するマクロ

質問

エクセルに入力済みの連続したデータを1行単位で以下のような内容でテキストファイルを作成し、
かつテキストファイル名を、セルに入力されている文字を使って保存するマクロを作りたいのですが、
どのようにしたら良いのでしょうか？よろしくお願いします。

*エクセルシート
（ファイル名：aaa.xls シート名：sheet1 エクセルシートがあるフォルダ名：yyy）

_|A |B |C |
1|x |y |z |
2|a1|a2|a3|
3|b1|b2|b3|

*テキストファイル（保存するフォルダ名：zzz）

---テキストファイルの内容（ファイル名：a1.txt）
x
a1

y
a2

z
a3
---
---テキストファイルの内容（ファイル名：b1.txt）
x
b1

y
b2

z
b3
---

エクセルはExcel2000でWindows2000を使用しております。

回答No.3

Wendy02 · ベストアンサー

このマクロは、そのデータとは関係のない余計なデータが右側セル、下側にあると、誤動作しますので、その点は注意してください。
必ず、<標準モジュール>でお使いください。

'目的のブックのシートを開いたままお使いください。
Sub ColumnOut2Text()
Dim i As Long
Dim j As Long
Dim Fno As Integer
Dim OutColumn As String
'ユーザー設定
　 Const myPath As String = "C:\ZZZ\"
　'かならず、最後に\ を入れてください。
'
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　Fno = FreeFile()
　Open myPath & .Cells(i, 1).Value & ".txt" For Output As #Fno
　For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
　　OutColumn = .Cells(1, j).Value & Chr(13) & .Cells(i, j).Value & Chr(13)
　 Print #Fno, OutColumn
　Next j
　OutColumn = Empty
　Close #Fno
Next i
End With
　Beep
End Sub

お礼

できました！ありがとうございます。

回答No.2

Zero_0

#1です。
保存するフォルダの指定がありました。
Dpath="zzz"　としてください。
このままだと、Excelファイルのあるパスに保存します。

お礼

了解しました。

回答No.1

Zero_0

これでどうですか。
Sub テキストファイル出力()

Sheets("sheet1").Select
i = 2
Dpath = ActiveWorkbook.Path
While Cells(i, 1) <> ""
Open Dpath & "\" & Cells(i, 1) & ".txt" For Output As #1
For j = 1 To 3
Print #1, Cells(1, j)
Print #1, Cells(2, j)
Print #1, ""
Next j
Close
i = i + 1
Wend

End Sub

お礼

回答ありがとうございます。やってみましたが、何も保存されませんでした。