営業部の予定表を一か月分つくる

予定表作成.vb

Option Explicit
'----------　基本仕様　----------
' シートを末尾にコピーする
' シート名を変える
' A2の日付を変える
' 31日までループする

Sub 予定表作成()
    
    Dim firstDay As Date
    firstDay = InputBox("何月のシートを作成しますか？1日から1ヵ月分作成します。", "指定してください", Date)    'デフォルトで今日の日付が入る
    Worksheets("1日").Range("A2") = firstDay
    
    Dim i As Integer
    For i = 1 To 30
        Worksheets("1日").Copy After:=Worksheets(Worksheets.Count)      '1日のコピーを末尾に作る
        Worksheets(Worksheets.Count).Name = i + 1 & "日"                'コピーしたシートの名前を変える
        Range("A2").Value = DateAdd("d", i, firstDay)                   '日付を一日ずつ足していく
    Next i
    
End Sub