Hello everyone. I'm new to the group and new to Excel VBA. I am attempting to create a summary workbook from around 50 individual workbooks, all with 1 worksheet. These individual workbooks are all updated constantly by different people. The goal is to create one workbook that links to cell values in each of the 50 sheets and I found some Ron de Bruin code that *almost* does what I need.

The worksheets all have values in A10:Dxx and I'm using the RDB_Last function to find the last row. They all have a "title" in cell A6. Here is a piece of what I'm using:

' Copy the value in cell A6 of each workbook to column A.
With sourceRange
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).Value = mybook.Worksheets(1).Range("A6")

End With

' Set the destination range.
Set destRange = BaseWks.Range("B" & rnum)

' Link the range from the source range
' to the destination range.
With sourceRange
Set destRange = destRange. _
Resize(.Rows.Count, .Columns.Count)
End With
--- sourceRange.Copy
--- BaseWks.Paste Link:=True
rnum = rnum + SourceRcount

The Copy/Paste Link lines are producing unexpected results but no errors. How do I create a link to the cells in each workbook? That is, the target workbook would have the following in columns A-E:

ColA: <target workbook value in A6,ColB: ='[Workbook1.xlsx]Sheet1'!A10, ColC: ='[Workbook1.xlsx]Sheet1'!B10, etc.

Thanks in advance!

Stan

Hi Stan

I found this code: http://www.ozgrid.com/VBA/loop-through.htm

This loops through all Workbooks within a folder, all you need to do is
insert your Copy/Paste ranges to complete it.

HTH
Mick.

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

'DO YOUR CODE HERE

wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

On Friday, March 29, 2013 9:49:56 AM UTC-4, Living the Dream wrote:
Hi Stan I found this code: http://www.ozgrid.com/VBA/loop-through.htm This loops through all Workbooks within a folder, all you need to do is insert your

Thank you, but the copy/paste is what isn't working. I already have working code to loop through my workbooks and select the ranges. The code piece I pasted is the only thing I need to make the whole macro work correctly.

So, to rephrase, how do I automate copying from WorkbookA to WorkbookB where what I want in WorkbookB is a link to the cells in WorkbookA?

Thanks,

Stan

Hi Stan,

Am Fri, 29 Mar 2013 07:32:30 -0700 (PDT) schrieb Aikistan:

So, to rephrase, how do I automate copying from WorkbookA to WorkbookB where what I want in WorkbookB is a link to the cells in WorkbookA?

set the target to paste in to one cell only.
Untested:
Set destRange = BaseWks.Range("B" & rnum)
SourceRange.Copy
destRange.Paste Link:=True


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Friday, March 29, 2013 11:16:09 AM UTC-4, Claus Busch wrote:
Untested: Set destRange = BaseWks.Range("B" & rnum) SourceRange.Copy destRange.Paste Link:=True

Claus,

Thank you for your reply. Unfortunately, the Paste Link line generates error 438. I seems like it *should* work. :(

Thanks,

Stan

Hi Stan,

Am Fri, 29 Mar 2013 10:39:58 -0700 (PDT) schrieb Aikistan:

Thank you for your reply. Unfortunately, the Paste Link line generates error 438. I seems like it *should* work. :(

how do you set the sourceRange?


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Stan,

Am Fri, 29 Mar 2013 10:39:58 -0700 (PDT) schrieb Aikistan:

Thank you for your reply. Unfortunately, the Paste Link line generates error 438. I seems like it *should* work. :(

try:
Set destRange = BaseWks.Range("B" & rnum)
SourceRange.Copy
Application.Goto DestRange
ActiveSheet.Paste Link:=True


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2