VBA to copy workbook and keep relative cell references between sheets

Question

I have workbook that has multiple sheets and need a macro button to save a copy of it and delete the sheet named "CSG". This was easy to do, but the problem was that all cell references pointed to the original workbook. With help, the problem has been tried to solve through name manager and break all links-code. Now the problem is that it break all references within the new workbook and copies only the values from the original workbook.

For example, in the original workbook sheet1 cell A1 has value 10, sheet2 cell A1 has cell reference "='sheet1'!A1". When I make the new copy, both cells do have the value 10, but the reference is no longer there. Is there a way to keep these references within the workbook without them referencing the original workbook? Below is the code currently being used.

Sub SaveTest()
Dim x           As Integer
    Dim FileName    As String, FilePath As String
    Dim NewWorkBook As Workbook, OldWorkBook As Workbook
   
    Set OldWorkBook = ThisWorkbook
   
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
   
    On Error Resume Next
    With OldWorkBook.Sheets("CSG")
        FilePath = "C:\Users\Tom\Desktop\" & .Range("B1").Value & " " & .Range("B2").Value
        FileName = .Range("B1").Value & " " & .Range("B2").Value & ".xlsx"
        
    End With
   
    MkDir FilePath
    On Error GoTo -1
   
    On Error GoTo myerror
    FilePath = FilePath & "\"
   
    For x = 2 To OldWorkBook.Worksheets.Count
        With OldWorkBook.Worksheets(x)
            If Not NewWorkBook Is Nothing Then
                .Copy after:=NewWorkBook.Worksheets(NewWorkBook.Worksheets.Count)
            Else
                .Copy
                Set NewWorkBook = ActiveWorkbook
            End If
        End With
    Next x
    
    DeleteBadNames NewWorkBook
    BreakAllLinks NewWorkBook
    UpdateNameManager NewWorkBook
    
    NewWorkBook.SaveAs FilePath & FileName, 51
       
     
myerror:
   If Not NewWorkBook Is Nothing Then NewWorkBook.Close False
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

End Sub

Instead of breaking links, you could do a Find/Replace to replace the old workbook name in every formula with a blank string. Then the formula will be preserved. — BigBen
What's wrong with first saving the workbook with the new name and then deleting the unwanted sheet? Also, when copying multiple worksheets with references to each other it is crucial to create an array of their names and using it, to copy them in one go. Then the references will work as intended. — VBasic2008

VBasic2008 VBasic2008 · Accepted Answer · 2021-04-09T17:32:13

Create a Copy of a Workbook

Option Explicit

Sub SaveTest()
   
    Dim OldWorkBook As Workbook: Set OldWorkBook = ThisWorkbook
    
    Dim WorkSheetNames() As String
    Dim FilePath As String
    Dim FileName As String
    
    With OldWorkBook.Worksheets("CSG")
        ReDim WorkSheetNames(1 To .Parent.Worksheets.Count)
        FilePath = "C:\Users\Tom\Desktop\" & .Range("B1").Value & " " _
            & .Range("B2").Value
        FileName = .Range("B1").Value & " " & .Range("B2").Value & ".xlsx"
    End With
   
    On Error Resume Next
    MkDir FilePath
    On Error GoTo 0
    FilePath = FilePath & "\"
   
    Dim ws As Worksheet
    Dim n As Long
    
    For Each ws In OldWorkBook.Worksheets
        n = n + 1
        WorkSheetNames(n) = ws.Name
    Next ws
    
    Application.ScreenUpdating = False
    
    OldWorkBook.Worksheets(WorkSheetNames).Copy
    
    With ActiveWorkbook ' new workbook
        Application.DisplayAlerts = False
        .Worksheets("CSG").Delete
        .SaveAs FilePath & FileName, 51 ' xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        '.Close SaveChanges:=False
    End With
    
    Application.ScreenUpdating = True
    
End Sub

VBA to copy workbook and keep relative cell references between sheets

1 Answers

Create a Copy of a Workbook