Excelマクロ紹介！シートコピー&リネームを一気にやる方法！

Sub SheetCopy()
Dim ws As Worksheet
Dim isSheet As Boolean
Dim newSheetList As Range
Dim newSheet As Range

    '選択範囲に値があるかチェック
    Set newSheetList = Selection
    '先頭セルに値がない場合
    If IsEmpty(newSheetList.Item(1).Value) = True Then
        '処理を終了
        MsgBox "セルに値がありません"
        Exit Sub
    End If
    
    'コピー元のシート名を入力
    copySheet = Application.InputBox("コピー元", "シート複製", Type:=2)
    If copySheet = "False" Then Exit Sub

    'シート存在フラグを0に設定
    isSheet = 0
    For Each A In Sheets
        'シート名が存在する場合、フラグを1に設定
        If A.Name = copySheet Then
            isSheet = 1
        End If
    Next
    
    'シートが存在しない場合
    If isSheet = 0 Then
        'メッセージを表示して終了
        MsgBox copySheet & "は存在しません"
        Exit Sub
    End If
    
    '選択したシート名を繰り返す
    For Each newSheet In newSheetList
        'シートコピー後、シート名を変更
        Worksheets(copySheet).Copy After:=Sheets(Sheets.count)
        ActiveSheet.Name = newSheet.Value
    Next
        MsgBox "コピー終了！"
End Sub