hiko-blog

VBA業務改善

MENU

ひな形の隣にシート追加

Sub AddSheetWithDate()
    Dim ws As Worksheet
    Dim newSheet As Worksheet
    Dim templateSheet As Worksheet
    Dim sheetName As String
    Dim templateFound As Boolean
    
    ' 今日の日付をMMDD形式で取得
    sheetName = Format(Date, "mmdd")
    
    ' すでに同じ名前のシートが存在する場合は、終了
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = sheetName Then
            MsgBox "今日の日付のシートはすでに存在します。", vbExclamation
            Exit Sub
        End If
    Next ws
    
    ' 指定したひな形のシートを探す
    templateFound = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = "ひな形" Then
            Set templateSheet = ws
            templateFound = True
            Exit For
        End If
    Next ws
    
    ' ひな形が見つからなかった場合はエラーメッセージを表示して終了
    If Not templateFound Then
        MsgBox "指定したひな形のシートが見つかりません。", vbExclamation
        Exit Sub
    End If
    
    ' 新しいシートをひな形の右に追加
    Set newSheet = ThisWorkbook.Sheets.Add(After:=templateSheet)
    
    ' 新しいシートの名前を設定
    newSheet.Name = sheetName
    
    ' 新しいシートに日付を書き込む
    newSheet.Range("A1").Value = "今日の日付: " & Format(Date, "MMDD")
    
    ' 新しいシートをアクティブにする
    newSheet.Activate
End Sub