【エクセルマクロ】シートコピーしてシート名を変更：5選

Sub 明日のシート追加()

Dim Ws As Worksheet
Dim Flg As Boolean
Dim GetDay As String

    'アクティブシート名の翌日が何月何日か取得
    GetDay = Format(DateValue(Year(Date) & "年" & ActiveSheet.Name) + 1, "m月d日")

    Flg = False

    'すでに同名シートがないかチェック
    For Each Ws In Worksheets
        If GetDay = Ws.Name Then
            Flg = True
            Exit For
        End If
    Next

    '同名シートがなければ
    If Flg = False Then

        'シートを末尾にコピーして、シート名を変更する
        ActiveSheet.Copy After:=ActiveSheet
        ActiveSheet.Name = GetDay

        MsgBox "完了"

    Else
        MsgBox "すでに翌日シートが存在しています。処理停止"
    End If

End Sub

Sub 翌日シート追加()

Dim Ws As Worksheet
Dim Kihonsht As Worksheet
Dim Flg As Boolean
Dim GetDay As String

    Set Kihonsht = Sheets("基本シート")

    '1番右端のシート名が何月何日か取得してプラス1日
    GetDay = Format(DateValue(Year(Date) & "年" & Sheets(Sheets.Count).Name) + 1, "m月d日")

    Flg = False

    'すでに同名シートがないかチェック
    For Each Ws In Worksheets
        If GetDay = Ws.Name Then
            Flg = True
            Exit For
        End If
    Next

    '同名シートがなければ
    If Flg = False Then

        '1番右端にシートをコピーして、シート名を変更する
        Kihonsht.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = GetDay

        'マクロボタン削除
        ActiveSheet.Shapes("Button 1").Delete

        MsgBox "完了"
    End If

End Sub

Sub 今日のシート追加()

Dim Ws As Worksheet
Dim Kihonsht As Worksheet
Dim Flg As Boolean
Dim GetDay As String

    Set Kihonsht = Sheets("基本シート")

    '本日の日付を取得
    GetDay = Format(Date, "m月d日")

    Flg = False

    'すでに同名シートがないかチェック
    For Each Ws In Worksheets
        If GetDay = Ws.Name Then
            Flg = True
            Exit For
        End If
    Next

    '同名シートがなければ
    If Flg = False Then

        '1番右端にシートをコピーして、シート名を変更する
        Kihonsht.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = GetDay

        'マクロボタン削除
        ActiveSheet.Shapes("Button 1").Delete

        MsgBox "完了"
    End If

End Sub

Sub 連番シート追加()

Dim Kihonsht As Worksheet
Dim i As Long

    Set Kihonsht = Sheets("基本シート")

    Application.ScreenUpdating = False

    For i = 1 To 10

        '1番右端にシートをコピーして、シート名を変更する
        Kihonsht.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = i

        'マクロボタン削除
        ActiveSheet.Shapes("Button 1").Delete

    Next i

    Application.ScreenUpdating = True

    MsgBox "完了"

End Sub

Sub 指定名称のシート追加()

Dim Kihonsht As Worksheet
Dim i As Long
Dim A As Variant

    '配列に値格納
    A = Array("りんご", "めろん", "ばなな")

    Set Kihonsht = Sheets("基本シート")

    Application.ScreenUpdating = False

    '配列ループ
    For i = 0 To UBound(A)

        '1番右端にシートをコピーして、シート名を変更する
        Kihonsht.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = A(i)

        'マクロボタン削除
        ActiveSheet.Shapes("Button 1").Delete

    Next i

    Application.ScreenUpdating = True

    MsgBox "完了"

End Sub