エクセルのマクロを使ってシートごとに名前をつけて保存したい

質問

マクロ初心者です。宜しくお願いします。

１つのブックにシートが複数あります。
それぞれシートをコピーして新しいブックを作成し
そのブックに名前をつけて保存したいです。

例えばブック名が「売上管理」でそのシートが「Ａ店」「Ｂ店」「Ｃ店」と３シートあるとします。

シート名：Ａ店を他のブックにコピーしてマイドキュメントに名前を付けて
保存する場合のマクロを教えてください。
ちなみにその際のブック名は「シート名+任意のセル（Ｄ２）」と
できれば一番助かります。

ちなみにＤ２のセルにはToday関数が入ってます。

回答No.1

zap35 · ベストアンサー

丸投げっぽくて、回答するのにためらいますが…(^^;
こんな感じでしょう。ただしブック名はシート名にしました。日付を付加するところは追加してみて下さい。（Format関数が必要です）

Sub Macro1()
Dim wb As Workbook
Dim sh As Worksheet
Dim svPath
　Set wb = ThisWorkbook
　svPath = "Z:\"　'パスは変更してください
　For Each r In wb.Worksheets
　　r.Copy
　　ActiveSheet.Name = r.Name
　　ActiveWorkbook.SaveAs Filename:=svPath & r.Name & ".xls"
　　ActiveWorkbook.Close
　Next r
　wb.Activate
End Sub

お礼

この度は本当にありがとうございました。

なんとか完成いたしました。

また機会がございましたら宜しくお願い致します。

補足

丸投げの質問をしてしまい申し訳ございません。
なにぶん素人なもので質問の仕方も悪く失礼いたしました。
それにも関わらず親切にご回答いただきまして大変たすかりました。

format関数の知識は無いのですがなんとか調べて作成してみます。

ActiveWorkbook.SaveAs Filename:=svPath & r.Name & ".xls"
↓
ActiveWorkbook.SaveAs Filename:=svPath & r.Name & ActiveSheet.Range("d2").Value & ".xls"
ここまでは何とかたどり着きました（＾＾；
ただセルd2のところが日付だとエラーが出ますが
文字なら問題なくファイル名を作成して保存できますので
頑張って完成目指します。

この度は本当にありがとうございました。