シート「シート名一覧」にシート名一覧を記載する

ListSheetNames.vb

Sub ListSheetNames()
    Dim ws As Worksheet
    Dim sheetNames() As String
    Dim i As Integer
    Dim listSheet As Worksheet
    
    ' 画面更新と自動計算を一時停止
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 1. シート名のリストを取得する
    ReDim sheetNames(1 To ThisWorkbook.Sheets.Count, 1 To 1)
    i = 1
    For Each ws In ThisWorkbook.Sheets
        sheetNames(i, 1) = ws.Name
        i = i + 1
    Next ws
    
    ' 2. シート「シート名一覧」が存在すれば削除し、再作成する
    On Error Resume Next
    Set listSheet = ThisWorkbook.Sheets("シート名一覧")
    If Not listSheet Is Nothing Then
        Application.DisplayAlerts = False
        listSheet.Delete
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0
    Set listSheet = ThisWorkbook.Sheets.Add
    listSheet.Name = "シート名一覧"
    
    ' 3. シート「シート名一覧」のA1セルから一括でシート名を書き込む
    listSheet.Range("A1").Resize(UBound(sheetNames, 1), 1).Value = sheetNames
    
    ' 4. シート「シート名一覧」を表示する
    listSheet.Activate
    
    ' 画面更新と自動計算を再開
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

ref: https://chatgpt.com/c/671f2276-5cb0-8003-8244-1cb4bbfb8bce