Hi,

below code is useful, but I do not want to choose any file for code to
start.Workbooks will be in 5 different folders.5 different folder will be in
one folder.code will automatically search the adress that I gave in the code.

for example adress will be d:\new folder ( new folder has 5 sub folders )

regards.
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Hi SAHRAYICEDIT-ISTANBUL

I'll wait on your reply to Jay before doing anymore on this but I am quite
happy to continue on it if you want me to. In the mean time, what version of
Excel are you using because it could make a difference as to how to approach
the problem?

Regards,

OssieMac

"Jay" wrote:

Hi SAHRAYICEDIT-ISTANBUL -

Below is a modified version of what I posted in yesterday's thread. It's an
amalgam of your original work, OssieMac's improvements, and my input. Use
this version as you see fit or extract the single statement from the code
that contains the word "Hyperlink" and insert it in your version where
appropriate.

This version permits browsing to the parent folder at run time, but only if
there is at least one file in that folder. When prompted, select any file in
a folder and choose Open.

Let us know how it works in your networked environment.
---------------------------------------------------------------------------------------------
Sub GetAllWorksheetNames()
Dim i As Integer
Dim L As Integer
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wbCodeBookws As Worksheet
Dim wSheet As Worksheet
Dim myFolderPath As String
Dim mySubFolderPath As String

On Error GoTo errorHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wbCodeBook = ThisWorkbook
Set wbCodeBookws = ActiveSheet
wbCodeBookws.Cells.Clear
ActiveWindow.FreezePanes = False

Range("A1") = "WorksheetName": Range("B1") = "SheetOrder"
Range("C1") = "FileName": Range("D1") = "FullPath"

pFolder = Application.GetOpenFilename
If pFolder < "False" Then
pFolder = Left(pFolder, InStrRev(pFolder, "\") - 1)
Else
MsgBox "Procedure canceled. No file selected."
Exit Sub
End If

With Application.filesearch
.NewSearch
.LookIn = pFolder
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then

For i = 1 To .FoundFiles.Count
L = InStrRev(.FoundFiles(i), "\")
mySubFolderPath = Left(.FoundFiles(i), L - 1)

If .FoundFiles(i) = ThisWorkbook.Path & "\" & ThisWorkbook.Name _
Or Mid(.FoundFiles(i), L + 1) = ThisWorkbook.Name Then
Set wbResults = ThisWorkbook
Else
Set wbResults = Workbooks.Open(.FoundFiles(i))
End If

'Lay in worksheet names
iw = 0
For Each wSheet In wbResults.Worksheets
If iw = 0 Then tRow = wbCodeBookws. _
Cells(Rows.Count, 1).End(xlUp)(2, 1).Row
wbCodeBookws.Cells(Rows.Count, 1).End(xlUp)(2, 1) _
= wSheet.Name
iw = iw + 1
wbCodeBookws.Cells(Rows.Count, 1).End(xlUp)(1, 2) _
= iw
Next 'wSheet
bRow = tRow + iw - 1

'Lay in filenames
wbCodeBookws.Range(wbCodeBookws.Cells(tRow, 3), _
wbCodeBookws.Cells(bRow, 3)) = Mid(.FoundFiles(i), L + 1)

'Lay in full workbook pathname as a hyperlink
For ih = tRow To bRow
ActiveSheet.Hyperlinks.Add _
Anchor:=wbCodeBookws.Cells(ih, 4), _
Address:=.FoundFiles(i)
Next ih

If wbResults.FullName < ThisWorkbook.FullName Then _
wbResults.Close SaveChanges:=False
Next i
End If
End With

'Sort list by folderpath, filename, and sheetorder
Range("A1").CurrentRegion.Sort Key1:=Range("D2"), _
Order1:=xlAscending, Key2:=Range("C2"), _
Order2:=xlAscending, Key3:=Range("B2"), _
Order3:=xlAscending, Header:=xlYes

'Format Output
wbCodeBookws.Activate
wbCodeBookws.Cells(2, 1).Select
ActiveWindow.FreezePanes = True
wbCodeBookws.Columns("A:D").AutoFit
Selection.AutoFilter

wrapSub:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

errorHandler:
MsgBox "An error occurred... action canceled."
Resume wrapSub

End Sub
--