View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default grab cell text from multi-tab workbook, show text in another w

Ok, try this test macro

Open Excel and only open the Summary Master workbook

Copy the macro in the Summary Master file and be sure that sheet where you want to have the links is active
When you run the macro you can browse to the file with the 82 tabs and the code will open the file.
It will loop through all sheets and of the sheet name exist in column A of the Summary Master workbook
in will add the formula next to it in column B.
When the code is ready it will close the file with 82 tabs.

Let me know if this is what you want ?

Sub Test()
Dim FileNameXls As Variant
Dim DestWks As Worksheet
Dim Rng As Range
Dim FinalSlash As Long
Dim PathStr As String
Dim JustFileName As String
Dim JustFolder As String
Dim mybook As Workbook
Dim sh As Worksheet

'Select the file with GetOpenFilename
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
MultiSelect:=False)

If FileNameXls = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set DestWks = ActiveSheet
Set mybook = Workbooks.Open(FileNameXls)

FinalSlash = InStrRev(FileNameXls, "\")
JustFileName = Mid(FileNameXls, FinalSlash + 1)
JustFolder = Left(FileNameXls, FinalSlash - 1)

For Each sh In mybook.Worksheets

With DestWks.Range("A:A")
Set Rng = .Find(What:=sh.Name, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & sh.Name & "'!"

Rng.Offset(0, 1).Formula = _
"=" & PathStr & Range("A50").Address

Else
'do nothing
End If
End With

Next sh

mybook.Close False
MsgBox "The macro is ready, check the result"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"pfa" wrote in message ...

Ron,

Thanks again for your assistance. You have been extremely helpful.
I look forward for your solution tomorrow.

Many thanks!