ブックのシート名を取得して一覧表を作成するエクセルVBA

ブックにあるシート名を取得して一覧表を作成するエクセルVBAをご紹介します。

次のサンプルコードを使うと、
<ul>
 	<li>「ファイルを開く」ダイアログを表示。</li>
 	<li>シート名を取得したいエクセルブックを選択。</li>
 	<li>選択したエクセルブックに、「シート名一覧」シートを追加。</li>
 	<li>エクセルブックに含まれる全シート名を取得、「シート名一覧」にシート名の一覧表を作成する。</li>
</ul>
という作業を自動化します。
<h2>操作方法</h2>
1、
下記サンプルコードを含むエクセルファイルを開き→「開発」→「マクロ」の順でクリック。
「Aシート名取得」→「実行」の順でクリック。
<img class="alignnone wp-image-388" src="http://www.wchack.com/hako001/wp-content/uploads/2019/05/001-2.png" alt="" width="706" height="447" />

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

3、
マクロが実行されます。
「シート名一覧」を追加、全シート名を取得して、
「シート名一覧」にシート名の一覧表を作成します。
<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" />

完了です。
<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 sh As Variant, flag As Boolean
    Dim ws As Worksheet
    Dim i As Long
    i = 0

    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
    
        Dim rc As Integer
        
        'メッセージ表示
        rc = MsgBox("シート「シート名一覧」を上書きしますか？" &amp; Chr(13) &amp; "※この処理は戻せません", vbYesNo + vbQuestion, "確認")
        
        If rc = vbYes Then
            '画面更新停止
            Application.ScreenUpdating = False
            
            'シート選択
            Worksheets("シート名一覧").Activate
        
            'シート削除
            ActiveSheet.Delete

            '画面更新停止
            Application.ScreenUpdating = True
            
            'メッセージ表示
            MsgBox "処理前のシート「シート名一覧」は削除済みです"
            
            'シート追加
            Worksheets.Add before:=Worksheets(1)
            
            'シート名変更
            ActiveSheet.Name = "シート名一覧"
    
            'シート選択
            Worksheets("シート名一覧").Activate

            Worksheets("シート名一覧").Activate
            Worksheets("シート名一覧").Range("A1").Value = "シート名（現在）"
            Worksheets("シート名一覧").Range("B1").Value = "シート名（変更後）"
            
            For Each ws In Worksheets
                Cells(Selection.row + i, Selection.Column).NumberFormatLocal = "@"
                Cells(Selection.row + i, Selection.Column) = ws.Name
                i = i + 1
            Next
            
            ActiveSheet.Name = "シート名一覧"
            Columns("A:B").Select
            Columns("A:B").EntireColumn.AutoFit
            Selection.NumberFormatLocal = "@"
            
        Else
            
            'メッセージ表示
            MsgBox "キャンセルされました。処理を終了します。"
        
        End If
        
    Else

        'シート追加
        Worksheets.Add before:=Worksheets(1)
        
        'シート名変更
        ActiveSheet.Name = "シート名一覧"

        'シート選択
        Worksheets("シート名一覧").Activate

        Worksheets("シート名一覧").Activate
        Worksheets("シート名一覧").Range("A1").Value = "シート名（現在）"
        Worksheets("シート名一覧").Range("B1").Value = "シート名（変更後）"
        
        For Each ws In Worksheets
            Cells(Selection.row + i, Selection.Column).NumberFormatLocal = "@"
            Cells(Selection.row + i, Selection.Column) = ws.Name
            i = i + 1
        Next
        
        ActiveSheet.Name = "シート名一覧"
        Columns("A:B").Select
        Columns("A:B").EntireColumn.AutoFit
        Selection.NumberFormatLocal = "@"
        
    End If
    
End Sub</pre>
&nbsp;
<h2>コードの特徴</h2>
<ul>
 	<li>「ファイルを開く」ダイアログを表示した後、キャンセルをクリックした場合、
キャンセル処理される様に対応しています。</li>
 	<li><a href="https://qiita.com/skillhunter007/items/f6bb725c15da76475ab9" target="_blank" rel="noopener">「ブックのシート名を一括で置換するエクセルVBA」</a>と連携可能な様にしています。</li>
</ul>