ブックのシート名を一括で置換するエクセルVBA

ブックのシート名を一括で置換するエクセルVBAをご紹介します。

次のサンプルコードを使うと、
<ul>
 	<li>「ファイルを開く」ダイアログを表示。</li>
 	<li>シート名を一括で置換したいエクセルブックを選択。</li>
 	<li>エクセルブックに含まれる全シート名を一括で置換する。</li>
</ul>
という作業を自動化します。
<h2>操作方法</h2>
1、
<a href="https://qiita.com/skillhunter007/items/d260de97d6ce24ad935e" target="_blank" rel="noopener">「ブックのシート名を取得して一覧表を作成するエクセルVBA」</a>を実行してシート名を取得。
<img class="alignnone size-full wp-image-390" src="http://www.wchack.com/hako001/wp-content/uploads/2019/05/003-1.png" alt="" width="700" height="594" />

2、
「シート名一覧」の「シート名（変更後）」に希望シート名を入力。
<img class="alignnone size-full wp-image-426" src="http://www.wchack.com/hako001/wp-content/uploads/2019/05/000-1.png" alt="" width="698" height="594" />

3、
下記サンプルコードを含むエクセルファイルを開き→「開発」→「マクロ」の順でクリック。
「Aシート名置換」→「実行」の順でクリック。
<img class="alignnone size-full wp-image-427" src="http://www.wchack.com/hako001/wp-content/uploads/2019/05/001-4.png" alt="" width="803" height="507" />

4、
ファイルを開くダイアログが表示されるので、シート名を置換したい対象のエクセルブックをクリックして、「開く」をクリック。
<img class="alignnone size-full wp-image-428" src="http://www.wchack.com/hako001/wp-content/uploads/2019/05/002-3.png" alt="" width="613" height="476" />

5、
マクロが実行されます。
「シート名一覧」以外のシート名を一括で置換します。
<img class="alignnone size-full wp-image-429" src="http://www.wchack.com/hako001/wp-content/uploads/2019/05/003-2.png" alt="" width="744" height="594" />

完了です。
<h2>サンプルコード</h2>
<pre class="lang:default decode:true ">Sub Aファイルを開く()
    Dim OpenFileName As String
    
    OpenFileName = Application.GetOpenFilename("Excelファイル,*.xls*")
    
    If OpenFileName = "False" Then
        
        MsgBox "キャンセルされました。処理を終了します。"
        
        End
        
    Else
        Workbooks.Open OpenFileName
    
    End If
    
End Sub
Sub Aシート名置換()
    Dim ws As Worksheet
    Dim row, col As Long
    Dim wsNames As Collection
    Dim sh As Variant, flag As Boolean
    
    Set wsNames = New Collection
    
    Call Aファイルを開く
    
    '画面更新停止
    Application.ScreenUpdating = False
    
    '確認ダイアログ停止
    Application.DisplayAlerts = False
    
    For Each sh In Sheets
        If sh.Name = "シート名一覧" Then
            flag = True
            Exit For
        End If
    Next sh

    If flag = True Then
        
        Worksheets("シート名一覧").Select
        Range(Range("A2"), Cells(Rows.Count, 2).End(xlUp)).Select
        
        row = Selection.row
        col = Selection.Column
        
        Do While Not IsEmpty(Cells(row, col))
            ' KeyがStrig型でないと「型が一致しません」というエラーになる
            wsNames.Add Item:=Cells(row, col + 1).Value, _
                         Key:=CStr(Cells(row, col).Value)
            row = row + 1
        Loop
    
    For Each ws In ActiveWorkbook.Worksheets
        On Error Resume Next
        ws.Name = wsNames.Item(ws.Name)
    Next


    Else
            
        'メッセージ表示
        MsgBox "シート「シート名一覧」はありません。" &amp; Chr(13) &amp; "先に「シート名取得」を実行して下さい。" &amp; Chr(13) &amp; "処理を終了します"
        
    ActiveWindow.Close
        
    End If
    
    '画面表示ON
    Application.ScreenUpdating = False
    
End Sub

</pre>
<h2>コードの特徴</h2>
<ul>
 	<li>「ファイルを開く」ダイアログを表示した後、キャンセルをクリックした場合、
キャンセル処理される様に対応しています。</li>
 	<li><a href="https://qiita.com/skillhunter007/items/d260de97d6ce24ad935e" target="_blank" rel="noopener">「ブックのシート名を取得して一覧表を作成するエクセルVBA」</a>と連携可能な様にしています。</li>
</ul>