This might help. The basis of this procedure was from a posting on the forum
yesterday. It obtains all workbooks in the current folder and any subfolders
and lists all the workbooknames and worksheet names within the workbooks and
records them on a spreadsheet in 2 columns. See if it gives you enough info
to base your required procedure. (If you only want the current folder then
ensure you change searchsubfolders to false)

Dim i As Integer 'Used in loop.
Dim j As Integer 'Used for row identifier when writing data.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Holds name of this workbook
Dim currentFile As String 'Id of current file with full path
Dim wSheet As Worksheet 'Worksheet in found workbook
Dim myCurrentPath As String 'Current path of this workbook
Dim myCurrentPathLgth As Integer 'Length of path string used in Mid()
function

Sub GetAllWorksheetNames()

'This macro designed to run from the folder where it has to _
search for the files and subfolders.
Sheets("Sheet1").Select

Cells.Select
Selection.Clear

'Insert column titles
Range("A1") = "Work Book Name"
Range("B1") = "Work Sheet Name"
Range("A1:B1").Font.Bold = True
Range("A1").Select

Application.DisplayAlerts = False
Application.EnableEvents = False

myCurrentPath = CurDir
currentFile = myCurrentPath & "\" & ActiveWorkbook.Name

'Plus 2 allows backslash plus 1 for next
'start character in the mid()function below
myCurrentPathLgth = Len(myCurrentPath) + 2

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist
j = 1 'Row numbers. Initialize as 1 to allow for column headers
For i = 1 To .FoundFiles.Count
'Test that not current file in use.
If LCase(.FoundFiles(i)) < LCase(currentFile) Then
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets
j = j + 1 'Sets row number
wbCodeBook.Sheets(1).Cells(j, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
wbCodeBook.Sheets(1).Cells(j, 2) = Format(wSheet.Name)
Next wSheet
wbResults.Close SaveChanges:=False
End If
Next i
End If
End With

Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CalculateFull

End Sub