EXCELマクロ シートの追加、シート名の変更

質問

おはようございます。
１つのブックで１ヶ月分のシートをつくるマクロを考えています。
月次処理シートのA列に例えば８月であれば、
0801　0802　0803・・・と入力。（もしくは0801から0831までをマクロで自動表示）
シートを１ヶ月分自動で生成するマクロを実行して、シート名を0801、0802、・・・とそれぞれ自動で変更。
１ヶ月分のブックの完成としたいのですが、どういうマクロを組めばよいでしょうか。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

もう、すでに回答が出ているようですが、私も考えてみました。
欲を言えば、年/月で設定させたほうがよいのですが、今回は、月だけです。

これは、Personal.xls の標準モジュールが良いのではないかと思います。

'-----------------------------------------------------------------
Sub DaysMonthAddedSheets()
''シート生成マクロ
Dim myMonth As Variant
Dim myDate As Date
Dim i As Integer, j As Integer
Dim m As Integer
Dim AcBook As Workbook
Set AcBook = ActiveWorkbook

'月と日付の決定
　myMonth = Application.InputBox("月を入力してください。" & vbCrLf & _
　"注意： 出力は、" & Year(Date) & "年の月の日付です", "シート生成マクロ", Type:=2)
　If myMonth = "" Or VarType(myMonth) = vbBoolean Then Exit Sub
　If Not IsNumeric(myMonth) Then
　　 MsgBox "数字を入れてください。"
　　 Exit Sub
　ElseIf 1 > CInt(myMonth) Or CInt(myMonth) > 12 Then
　　　MsgBox "月数が正しくありません。"
　　　Exit Sub
　End If

　myDate = DateSerial(Year(Date), myMonth + 1, 0)
　m = Day(myDate)

'シート生成
Application.ScreenUpdating = False
With AcBook
　 i = .Worksheets.Count
　 .Worksheets.Add After:=.Worksheets(i), Count:=(m - i)
　 On Error GoTo ErrHandler
　 For j = 1 To m
　　.Worksheets(j).Name = Format$(myDate - m + j, "mmdd")
　 Next j
　 '終了後は、1日のシートへ
　 .Worksheets(Format$(myDate - m + 1, "mmdd")).Select
End With
Set AcBook = Nothing
Exit Sub

Application.ScreenUpdating = True
ErrHandler:
　'再生成のエラー処理
　AcBook.Worksheets(Format$(myDate - m + j, "mmdd")).Name = "Temp"
　Resume
　Err.Clear
End Sub
'-----------------------------------------------------------------

お礼

Wendy02さん、こんにちは。
お礼が前後して申し訳ないです。
実行してみました。
相変わらず、すごい！！正直な感想です。
どうもありがとうございました。

回答No.1

merlionXX

やろうとしていることがいまいちよくわからないのですが、

１．「月次処理」という名前のシートのA列にmmdd形式で１日から最終日までを自動で記入する。
２．A列に入力した数だけシートを追加しA列セルと同じ名前にする。

というサンプルです。ご参考まで。

Sub test01()
m = Application.InputBox("何月分ですか？2006/08のように入力してください。")
fd = m & "/01"
ld = Day(DateSerial(Year(fd), Month(fd) + 1, 0))
With Sheets("月次処理").Cells(1, 1)
.NumberFormatLocal = "mmdd"
.Value = fd
.AutoFill Destination:=Range("A1:A" & ld)
For i = 1 To ld
Set ns = Sheets.Add(After:=Sheets(Sheets.Count))
ns.Name = .Offset(i - 1).Text
Next
End With
End Sub

お礼

＞やろうとしていることがいまいちよくわからないのですが

いえいえ、つたない説明でここまで完璧なマクロを教えていただきありがとうございました。
非常に助かりました。