Excelのシート名を一括変更するマクロ

使い方
１．コード1を実行してシート名一覧を作成する
２．シート名一覧のC列(変更後のシート名)を書き換える
３．コード2を実行する

コード1

'シート名を取得して新規シートに一覧出力する
Sub getAllSheetsName()

    Dim sname: sname = "シート名一覧_あとでこのシートは消してね"

    '作業用シートが存在していたら削除する
    Dim ws As Worksheet
    Dim flag As Boolean
    For Each ws In Worksheets
        If ws.Name = sname Then
            flag = True
            Exit For
        End If
    Next ws
    If flag = True Then
        Application.DisplayAlerts = False
        Worksheets(sname).Delete
        Application.DisplayAlerts = True
    End If


    '作業用シートを作成する
    Sheets.Add
    ActiveSheet.Name = sname

    'シート一覧を作成する
    Dim ss: Set ss = ActiveSheet
    ss.Cells(1, 2) = "シート名"
    ss.Cells(1, 3) = "変更後のシート名"
    Dim r: r = 2
    For Each ws In Sheets
        If ws.Name <> sname Then
            ss.Cells(r, 2) = ws.Name
            ss.Cells(r, 3) = ws.Name
            ss.Cells(r, 4) = "=B" & r & "=C" & r
            r = r + 1
        End If
    Next ws

    '見た目整理
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Range("B1:D1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

    ss.Cells(1, 1).Select
End Sub

コード2

'シート名を一括変更する
Sub ChangeSheetName()
    Dim map As Dictionary: Set map = New Dictionary

    Dim sname: sname = "シート名一覧_あとでこのシートは消してね"
    Dim ss: Set ss = Sheets(sname)
    Dim r
    '// 変更前シート名をキー、変更後シート名を値としてマップに設定
    For r = 2 To 2000
        '変更前シート名無しの場合、終了
        If ss.Cells(r, 2) = "" Then
            Exit For
        End If

        '変更後シート名ありの場合、mapに保存
        If ss.Cells(r, 3) <> ss.Cells(r, 2) Then
            Call map.Add(ss.Cells(r, 2).Value, ss.Cells(r, 3).Value)
            ss.Cells(r, 2) = ss.Cells(r, 3)
        Else
        End If
    Next


    Dim sht         As Object       '// シート
    '// 全シートループ
    For Each sht In Sheets
        If map.Exists(sht.Name) Then
            sht.Name = map.Item(sht.Name)
        End If
    Next
End Sub