excel新ブック作成しシートをコピーし名前つけ

質問

マクロ初心者です。
Excel2003を使っています。
新ブックを作って、指定分のコピーシートを作製し、更にブックとシートに名前をつけて、もっと言えば各シートのセルA2の場所にシート名と同じ日付が入る
夢のようなワンクリックのマクロが出来ないものでしょうか？
よろしくお願いいたします。

回答No.2

mar00

補足を読みましたがマクロの内容をほぼ理解できていると思います。
質問してコピーして出来たら終わりという質問者が多い中で、きちんと理解しようとなさっているので
回答した側としても回答してよかったと思います。

>'"\"マークが付いているブックを選びます←勉強不足でどんな時必要なのかわかりません
新しいマクロの記録を実行してみるとわかりますがフォルダ名の後に必ず\がつきます。
次の記述はBook2.xlsを新しいマクロの記録で保存した時の記述です。
****の部分はフォルダ名が記述されます。
" ActiveWorkbook.SaveAs Filename:= _
""C:\****\****\****\Book2.xls"", FileFormat:= _
xlNormal, Password:="""", WriteResPassword:="""", ReadOnlyRecommended:=False _
, CreateBackup:=False"

myPath = ThisWorkbook.Path & "\"は
ThisWorkbook.Pathでコピー元のブックの保存してあるブォルダを取得できるのですが
"C:\****\****\****"のような状態で取得されるため& "\"としています。

補足
myFile = Month(x) & "月"はmyFile = Month(x) & "月.xls"としても構いません。
その場合、ActiveWorkbook.SaveAs Filename:=myPath & myFile & ".xls"を
ActiveWorkbook.SaveAs Filename:=myPath & myFileとします。

Sheets(2).CopyはSheets("フォーム").Copyとすることもできます。画像を見るとシートが2番目にあったので2としています。

Sheets.Countは一番最後のシートの番号を取得できます。

お礼

mar00さん

丁寧な解説、ありがとうございます。
￥の後にファイル名を入れるって事でしょうか。
やってみます(^^)/

回答No.1

mar00

マクロを実行するとインプットボックスが出てくるので今年の2月を作成したい場合、
2012/2と入力して下さい。
新しいブックはコピー元のブックと同じフォルダに保存されます。
Sub Macro1()
myPath = ThisWorkbook.Path & "\"
x = InputBox("年月を入力して下さい。")
bb = Day(DateAdd("m", 1, x) - 1) - 1
myFile = Month(x) & "月"
Sheets(2).Copy
Sheets(Sheets.Count).Name = Sheets.Count & "日"
Range("A2") = Sheets.Count & "日"
Do While aa < bb
aa = Sheets.Count
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets.Count & "日"
Range("A2") = Sheets.Count & "日"
Loop
Sheets(1).Select
ActiveWorkbook.SaveAs Filename:=myPath & myFile & ".xls"
Snd Sub
ご希望通りのものであればいいのですが。

お礼

とても早いご回答ありがとうございました。
出来ました！　希望どうりで夢のようです。

各シートのA2のセルにシート名と同じ日付を入れるのが出来ないのですが、
セルに入力規制がかかっていたせいかもしれません。
もう一度新しくコピーしてやってみます。

ありがとうございました。

補足

Sub Macro1()

'"\"マークが付いているブックを選びます←勉強不足でどんな時必要なのかわかりません
myPath = ThisWorkbook.Path & "\"

'インプットボックスを開き指定月を入力します
x = InputBox("年月を入力して下さい。")

'指定された月の最終日を割り出します
bb = Day(DateAdd("m", 1, x) - 1) - 1

'指定された月を名前として取得します
myFile = Month(x) & "月"

'フォームのシートをコピーします
Sheets(2).Copy

'1番最初のシートに名前をつけます
Sheets(Sheets.Count).Name = Sheets.Count & "日"

'一番最初のシートの"X1"に日付を入れます
Sheets(Sheets.Count).Range("X1") = Sheets.Count

'指定した月の最後の日まで繰り返します
Do While aa < bb
aa = Sheets.Count
'<シートをコピー>
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
'<シートに名前をつける>
Sheets(Sheets.Count).Name = Sheets.Count & "日"
'<各シートの"X1"に日付を入れる>
Sheets(Sheets.Count).Range("X1") = Sheets.Count
'ここまでを繰り返します
Loop

'新しく作ったブックの先頭のシートに移動します
Sheets(1).Select
'新しく作ったブックに月の名前をつけて保存します
ActiveWorkbook.SaveAs Filename:=myPath & myFile & ".xls"

End Sub

これで出来ました（＾＾）
（日付を入れるセルがX1になって"日"を無くしました。）
ありがとうございました。m(_ _)m