linking to multiple workbooks

[Guest]

I have 50 or so workbooks each with 1 sheet in them. I am trying to create
one master workbook that will essentially look the same as the individual
sheets in the different workbooks. Every sheet has the exact same cells and
formulas on them. I want to link the 50 workbooks to one master, but I don't
want to open each one and link it that way. Is there a way to merge
workbooks, or an easier way of linking everything. Any assistance welcom.

Thanks

 

[Ron de Bruin]

Start with this example for a few cells
http://www.rondebruin.nl/summary2.htm

How big is the range that you want to link to ?
I can make a example for you if you want if you give me this information

Without links you can use this
http://www.rondebruin.nl/copy3.htm

 

[Guest]

Thank you for your suggestions.

Each workbook has 1 sheet with a different name for that sheet, however the
sheet name matches the workbook name. I was looking at your examples and
thought that might be important. As for ranges, each worksheet will have
about 10 links that I need pulling off information. I only have one range
that I will need to do an addition with. for example
A1 B1 C1 D1
E1 etc.
row 1 "wrkbook name" phone calls (Range/link) emails (range/link)
etc.


Let me know if this helps at all.

Thanks

 

[Guest]

I also wanted to mention that I did try your code, but it was always yellow.
I think I am not understanding the formula building part of your code,
however I did get the new workbook with the first column having the workbook
name in it.

Thanks

 

[Ron de Bruin]

Hi

Sorry for the late response (very busy)

Try this example
It will make links to Range("A1:E1")
It use the sheet with the same name as the workbook name

Sub Summary_cells_from_Different_Workbooks()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String

Set Rng = Range("A1:E1") '<---- Change

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
'Select the files with GetOpenFilename

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

Set SummWks = Workbooks.Add(1).Worksheets(1)
'Add a new workbook with one sheet for the Summary

RwNum = 1
'The links to the first sheet will start in row 2

For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = RwNum + 1

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

SummWks.Cells(RwNum, 1).Value = JustFileName
'copy the workbook name in column A

ShName = Left(JustFileName, Len(JustFileName) - 4)

PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"
'build the formula string

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))

If Err.Number <> 0 Then
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
'If the sheet name not exist in the workbook the row color will be Yellow.
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

SummWks.UsedRange.Columns.AutoFit
' Use AutoFit for setting the column width in the new workbook

MsgBox "The Summary is ready, save the file if you want to keep it"

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