EXCELの複数シートをそれぞれ別ブックへ保存したい

質問

EXCEL97を使用しています。
1つのブック内に複数のシート（10～20枚）があります。
これを全て1シートずつの別のブックに分けて保存をするマクロを作成したいのですが、できますでしょうか？

できれば各シート内の(A4)に入力されている文字列を各ブックの名前として使用したいのですが・・・。
（各シートのセルA4の値に重複はありません）

現在は各シートを新しいブックにコピーして名前を付けて保存、の作業をシート数分繰り返しています。

すみませんがよろしくお願いいたします。

回答No.3

tbobi · ベストアンサー

s_chikayoさん　こんばんは。

こちらも参考にしてください。

各シートをコピーし新規ブックとして保存して閉じます。
元のブックは開いたまま残ります。
保存先を変える場合は、ChDirのカッコ内を変えてください。なお、指定したフォルダが存在しないとエラーになります。

Sub SheetCopy()

　　Dim ShtCnt As Integer, i As Integer
　　ShtCnt = ActiveWorkbook.Worksheets.Count
　　i = 1
　　'保存場所を指定
　　ChDir ("C:\TEST\")

　　Do
　　　　Sheets(i).Activate
　　　　Sheets(i).Copy
　　　　ActiveWorkbook.Close savechanges:=True _
　　　　, FileName:=ActiveSheet.Range("A4").Value & ".xls"
　　　　i = i + 1
　　Loop Until i > ShtCnt

End Sub

お礼

お返事遅くなりましてすみません。
大変参考になりました。ありがとうございます。

補足

自宅のWindows98マシンでは問題なく動きましたが、会社のNTでは保存場所の指定がうまくできませんでした。(^_^;)
保存したいフォルダにあらかじめマクロを置いておいてChDir～の行を抜いておけば支障はないので、とりあえず業務上は助かりました。

回答No.2

VT250F

マクロなら何でもできますよ。
試しに、録音ボタン（赤い丸印）を押して、
マクロを生成するとよろしかろう。
あとは、シート名を取得する関数などを利用して、
for - next あたりでループする。・・・
この言葉がわかるようになると、中級です。
だいたい、なんでもこなせるようになります。
わからなければ、書店でその手の本を、
立ち読みでもすれば、よろしいでしょう。
健闘を祈ります。

お礼

お返事遅くなりましてすみません。
ありがとうございます。勉強します。

回答No.1

papayuka

こんにちは。

対象ブックにマクロを仕込むなら、こんな感じでも良いかと。
最後に対象ブックはシート１枚だけになります。

Sub aaa()
Dim i As Integer
For i = Worksheets.Count To 2 Step -1
　Worksheets(i).Move
　ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" _
　　　　　　　　& ActiveSheet.Range("A4") & ".xls"
　ThisWorkbook.Activate
Next i
End Sub

お礼

お返事遅くなりましてすみません。
大変参考になりました。ありがとうございます。