Replacing references from one file to another

[ewan7279]

Hi,

I have a master workbook that contains numerous cost centre spreadsheets.
Each month I run a macro to create copies of certain sheets within the
workbook, specified by a range on the first sheet of the workbook. The code
is as follows:

Dim CELL As Range, RNG As Range
With Worksheets("SETUP SHEET")
Set RNG = .Range(.Range("C3:C52"), .Range("C3:C52").End(xlDown))
End With

Application.STATUSBAR = "Please wait while your spreadsheets are copied to
your HOME folder..."
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs FileName:=Sheets("MyName").Range("A1").Value & ".xls"
For Each CELL In RNG
If CELL <> "BLANKS" Then
If CELL <> "" Then
Sheets(CELL.Value).Copy
ActiveWorkbook.SaveAs FileName:=ActiveSheet.Range("A1").Value &
".xls"
ActiveWorkbook.Close
End If
End If
Next

I now want to include a summary sheet (also contained in the master
workbook) for each of the cost centre sheets that is copied. The problem I
find is that once the spreadsheet and summary have been copied into a new
workbook, the summary still refers to the master workbook, but I want it to
refer to the cost centre sheet that it has just been copied into a new
workbook with. I have tried to create a variable workbook name, as the
application is intended for use on a wider scale and thus the names will
change dependant upon the unit using it.

I have tried to adjust this code in a number of ways, but have been
unsuccessful at each attempt. One such attempt is as follows:

Dim WKBOOK As Workbook
Dim ACTIVSHT As Worksheet
Dim BKNAME As String
Dim CELL As Range, RNG As Range
With Worksheets("SETUP SHEET")
Set RNG = .Range(.Range("C3:C52"), .Range("C3:C52").End(xlDown))
End With

Application.STATUSBAR = "Please wait while your spreadsheets are copied to
your HOME folder..."
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs FileName:=Sheets("MyName").Range("A1").Value & ".xls"
BKNAME = Sheets("MyName").Range("A11").Value & ".xls"
Set WKBOOK = BKNAME
For Each CELL In RNG
If CELL <> "BLANKS" Then
If CELL <> "" Then
Sheets(Array("SUMMARY", CELL.Value)).Copy
Sheets(CELL.Value).Select
ActiveWorkbook.SaveAs FileName:=ActiveSheet.Range("A1").Value &
".xls"
ACTIVSHT = ActiveSheet.Name
Sheets("SUMMARY").Select
Range("C9:R47").Select
Selection.Replace What:="'[WKBOOK]TOTAL'",
Replacement:=ACTIVSHT.Name, LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, _
ReplaceFormat:=False
ActiveWorkbook.Close
End If
End If
Next

I have very little experience of VB, but I think I'm quite close in what I
am trying to do(?!) I hope I have made myself clear. Please help!!

 

[Simon Murphy]

try something like:

ActiveWorkbook.ChangeLink Name:= _
"C:\data\book1.xls", NewName:= _
"C:\Data\book2.xls", Type:=xlExcelLinks


this is the equivalent of edit>>links>>change source

the edit replace approach you are currently doing may well work - I
have found it better to replace '=' with 'xx' first to convert to text,
then put it back to a formula after.

I prefer the .changelink approach though - you will need the full path
(workbook.FullName)

cheers
Simon

 

[ewan7279]

Hi Simon,

Thanks for responding. The problem is, I do not always know what the name
of the workbook is going to be, because it has been designed for any user to
specify its cost centres etc.

The name of each cost centre sheet that is copied is contained within the
sheet itself. Could the method you propose be used in this way too? Where
in the code would it go/what code would be replaced?

Thanks,

Ewan.