Removing sharepoint links within formulas using VBA

Question

I have a macro that copies a set of sheets from a source workbook to a new workbook. These sheets contain formulas that reference each other in various ways.

My macro successfully copies over these sheets into the new workbook but the formulas still contain the sharepoint link to the source workbook.

e.g.

Formula copied over as part of sheets: =SUM('https://companyname.com/teams/Accounts/Shared Documents/Reporting/[sourceworkbook.xlsx]Sheet1'!G:G)+SUM('https://companyname.com/teams/Accounts/Shared Documents/Reporting/[sourceworkbook.xlsx]Sheet2'!G:G)

Formuala to be: =sum('Sheet1'!G:G)+('Sheet2'!G:G)

There are several differing formulas but this is the basic premise of the problem.

My code that copies the sheets over is this:

Sub CopySheetsFromWorkbook()
    Dim sourceWorkbook As Workbook
    Dim destinationWorkbook As Workbook
    Dim sheetNames As Variant
    Dim i As Integer
    Dim lastSheet As Worksheet
    Dim ws As Worksheet
    Dim sourceWorkbookName As String

    ' Set the names of the sheets to copy
    sheetNames = Array("Sheet1", "Sheet2", _
                       "Sheet3")

    ' Set the destination workbook (current workbook)
    Set destinationWorkbook = ThisWorkbook

    ' Prompt user to open the source workbook
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "Select the workbook to copy sheets from"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb"
        
        If .Show = -1 Then ' If the user selects a file
            Set sourceWorkbook = Workbooks.Open(.SelectedItems(1))
            sourceWorkbookName = sourceWorkbook.Name
        Else
            MsgBox "No file selected. Exiting macro.", vbExclamation
            Exit Sub
        End If
    End With

    ' Find the sheet before which to paste the copied sheets
    On Error Resume Next
    Set lastSheet = destinationWorkbook.Sheets("Sheetname")
    On Error GoTo 0
    
    If lastSheet Is Nothing Then
        MsgBox "Sheet 'Sheetname' not found in the destination workbook.", vbExclamation
        sourceWorkbook.Close False
        Exit Sub
    End If

    ' Loop through the sheet names and copy each one
    Application.ScreenUpdating = False
    For i = LBound(sheetNames) To UBound(sheetNames)
        On Error Resume Next
        Set ws = sourceWorkbook.Sheets(sheetNames(i))
        On Error GoTo 0
        
        If ws Is Nothing Then
            MsgBox "Sheet '" & sheetNames(i) & "' not found in the source workbook.", vbExclamation
            sourceWorkbook.Close False
            Exit Sub
        End If
        
        ' Create a true copy of the sheet in the destination workbook
        ws.Copy Before:=lastSheet
        
        ' Update formulas to remove references to the source workbook
        With destinationWorkbook.Sheets(ws.Name)
            UpdateFormulasToLocal .Cells
        End With
    Next i
    Application.ScreenUpdating = True
    
    ' Close the source workbook without saving
    sourceWorkbook.Close False
    
    MsgBox "Sheets copied successfully.", vbInformation
End Sub

So im assuming its because i am trying to paste rather than use the excel process of right clicking and 'move or copy'. Can this be done?

Answer 1

You should be able to use the ChangeLink functionality to switch the external links to internal ones like this:

Sub MakeSPLinksLocal()
    Dim LinkArray
    Dim i As Long
    LinkArray = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(LinkArray) Then
        For i = LBound(LinkArray) To UBound(LinkArray)
            If InStr(1, LinkArray(i), "https", vbTextCompare) Then ActiveWorkbook.ChangeLink LinkArray(i), ActiveWorkbook.FullName, xlLinkTypeExcelLinks
        Next i
    End If
End Sub