Sub ListSheets()
Dim shtEnum As Object, shtDest As Worksheet, lngRow As Long
Set shtDest = Worksheets.Add
On Error Resume Next
shtDest.Name = "Sheet List"
shtDest.Range("A1").Value = "Sheet name"
lngRow = 2
For Each shtEnum In ActiveWorkbook.Sheets
If shtEnum.Name <> "Sheet List" Then
shtDest.Cells(lngRow, 1).Value = shtEnum.Name
lngRow = lngRow + 1
End If
Next shtEnum
End Sub