VBA code for pasting links -- modifying RDB code for summary workbook

[Aikistan]

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 A10xx 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

 

[Living the Dream]

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

 

[Aikistan]

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

 

[Claus Busch]

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

 

[Aikistan]

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

 

[Claus Busch]

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

 

[Claus Busch]

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

 

[Aikistan]

SourceRange.Copy Application.Goto DestRange ActiveSheet.Paste Link:=True Regards Claus Busch

That worked!

I had to answer "You have a lot of info on the clipboard, do you want to save it?" for each sheet as the macro closed it, though. Is there a way to suppress that message (this is just for future information...with the links pasting, I only had to run the macro once)!

Thank you very much!

Stan

 

[GS]

Add the line shown below Claus' code...

Set destRange = BaseWks.Range("B" & rnum)
SourceRange.Copy
Application.Goto DestRange
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False '//clear the clipboard

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Aikistan]

Application.CutCopyMode = False '//clear the clipboard -- Garry

Awesome! This works like a champ, now. If only my source data were cleaner...

Thank you,

Stan

 

[Claus Busch]

Hi Stan,

Am Fri, 29 Mar 2013 13:30:14 -0700 (PDT) schrieb Aikistan:

Awesome! This works like a champ, now. If only my source data were cleaner...

when you open the workbook with the data, the workbook is the
ActiveWorkbook.
Then try:
With ActiveWorkbook.Sheets(1)
LRowS = .Cells(.Rows.Count, 1).End(xlUp).Row
Set SourceRange = .Range("A10" & LRowS)
End With


Regards
Claus Busch

 

[Aikistan]

Regards Claus Busch

Thanks, Claus, it's working!