【VBA】一瞬でシートのコピー、名前変更が出来る方法

Sub シートをコピーする()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("見積書")

Dim wsName As String
wsName = ws.Cells(3, 1).Value

' 同名のワークシートがないことをチェック
If nameCheckFlag(wsName) = True Then

    MsgBox "同名のシートが存在するため、シートを作成できません。"

Else
    ' 「見積書」シートをコピーして一番右に追加する。
    ws.Copy After:=Sheets(Sheets.Count)

    ' 追加したシートがActiveになっているので、ActiveSheetを通じて名前を設定する。
    ActiveSheet.name = wsName

End If

' 見積書シートをアクティブにする
ws.Activate

End Sub

' 同名のワークシートがないかチェックする関数
Function nameCheckFlag(wsName As String) As Boolean
    Dim ws As Worksheet

    For Each ws In Worksheets
        If wsName = ws.name Then
            nameCheckFlag = True
            Exit For
        Else
            nameCheckFlag = False
        End If
    Next ws

End Function

Function nameCheckFlag(wsName As String) As Boolean
    Dim ws As Worksheet

    For Each ws In Worksheets
        If wsName = ws.name Then
            nameCheckFlag = True
            Exit For
        Else
            nameCheckFlag = False
        End If
    Next ws

End Function

For Each ws In Worksheets
        If wsName = ws.name Then
            nameCheckFlag = True
            Exit For
        Else
            nameCheckFlag = False
        End If
    Next ws