整理できなくなってきたので、Github化します。
' シート一覧を取得
' GetWorkbookAllSheets Macro
' Keyboard Shortcut: Ctrl+Shift+W
Sub GetWorkbookAllSheets()
    Dim ws As Worksheet
    Dim newSheet As Worksheet
    Dim i As Integer
    
    ' アクティブシートを取得
    Dim activeIndex As Integer
    activeIndex = ActiveSheet.Index
    
    ' 新しいシートをアクティブシートの右に挿入
    Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(activeIndex))
    newSheet.Name = "シート一覧"
    
    ' シート一覧を書き出し
    With newSheet
        ' 初期化
        .Cells.Clear
        ' ヘッダーを書く
        .Cells(1, 1).Value = "シート名"
        i = 2 ' データの開始行
        ' 各シート名を取得
        For Each ws In ThisWorkbook.Sheets
            .Cells(i, 1).Value = ws.Name
            i = i + 1
        Next ws
    End With
End Sub