シート名変更マクロ～重複エラー回避～データ集計業務に即したマクロVBA

<スポンサーリンク>

必要なところをコピーしてvbaに張り付け。もしくは、すべてをコピーしてCallで呼び出してもらえたらと思います。

シート名を変更する際に重複した場合、名前を変更するマクロ

シート名を変更したときに名前が重複するとエラーで止まってしまうと思いますが、重複した場合、
①既存のシートを消して上書き　
or　
②新しい名前を入力して保存するコードです。

Call　ChangeSheetName("AAAAAAA")　で呼び出してください。
　　　※”AAAAAAA”の代わりにつけたい名前を入力。

Sub MAIN()
　　Call　ChangeSheetName("AAAAAAA")
End Sub
 
Public Sub ChangeSheetName(BookName As String)
 
'名前ダブり確認
    Dim ws As Worksheet, flag As Boolean
    Dim RC As Integer
     
'名前を付け替えたときにまたダブっていたらループ
Label100:
     
    flag = False
     
    'ワークシートで同じ名前がないか検索
    For Each ws In Worksheets
        If ws.Name = BookName Then flag = True
    Next ws
     
    '同じ名前があったら消すか確認
     
    If flag = True Then
     
        RC = MsgBox(BookName & "が存在します。書き換えますか?", vbYesNo + vbQuestion, "確認")
         
        If RC = vbYes Then
         
            Application.DisplayAlerts = False
             
            Worksheets(BookName).Delete
             
            Application.DisplayAlerts = True
         
        Else
         
            '消さない場合は名前を入力
         
            BookName = InputBox("名前を入力")
             
            GoTo Label100
             
        End If
 
    End If
     
    '名前を変更
     
    ActiveSheet.Name = BookName
 
End Sub