整理できなくなってきたので、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