Sub ExtractSheetNames()
Dim VBProj As Object
Dim VBComp As Object
Dim Code As String
Dim Line As String
Dim i As Integer
Dim StartPos As Integer
Dim EndPos As Integer
Dim SheetName As String
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ModuleName")
Code = VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
For i = 1 To VBComp.CodeModule.CountOfLines
Line = VBComp.CodeModule.Lines(i, 1)
If InStr(Line, "Sheets(") > 0 Or InStr(Line, "Worksheets(") > 0 Then
StartPos = InStr(Line, "(") + 2
EndPos = InStr(Line, ")") - 1
SheetName = Mid(Line, StartPos, EndPos - StartPos)
SheetName = Replace(SheetName, Chr(34), "")
Debug.Print "Found Sheet: " & SheetName
End If
Next i
End Sub
Dim VBProj As Object
Dim VBComp As Object
Dim Code As String
Dim Line As String
Dim i As Integer
Dim StartPos As Integer
Dim EndPos As Integer
Dim SheetName As String
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ModuleName")
Code = VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
For i = 1 To VBComp.CodeModule.CountOfLines
Line = VBComp.CodeModule.Lines(i, 1)
If InStr(Line, "Sheets(") > 0 Or InStr(Line, "Worksheets(") > 0 Then
StartPos = InStr(Line, "(") + 2
EndPos = InStr(Line, ")") - 1
SheetName = Mid(Line, StartPos, EndPos - StartPos)
SheetName = Replace(SheetName, Chr(34), "")
Debug.Print "Found Sheet: " & SheetName
End If
Next i
End Sub