Help solve "Run-time error '13': Type mismatch"

[swapnilk]

I am using the below code to copy specific sheets to a new workbook and then break the external links in the new workbook. The code works perfectly fine. However, when i save it as 'Add-In' and run it in some other excel file I get the error "Run-time error '13': Type mismatch" at line "For Each link In wbTarget.LinkSources(xlLinkTypeExcelLinks)". Can someone help me get the below code working as an Add-In please?

Sub CopySheets()
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim ws As Worksheet
    Dim sheetNames As Variant
    Dim targetSheet As Worksheet
    Dim link As Variant
    
    ' Disable screen updating
    Application.ScreenUpdating = False
    
    ' Set the source workbook
    Set wbSource = ThisWorkbook
    
    ' Define the sheet names to be copied
    sheetNames = Array("SheetNameA", "SheetNameB", "SheetNameC", "SheetNameD", "SheetNameE")
    
    ' Create a new workbook
    Set wbTarget = Workbooks.Add
    
    ' Loop through each sheet name
    For Each ws In wbSource.Sheets
        If IsInArray(ws.Name, sheetNames) Then
            ' Copy the sheet to the new workbook
            ws.Copy After:=wbTarget.Sheets(wbTarget.Sheets.Count)
            Set targetSheet = wbTarget.Sheets(wbTarget.Sheets.Count)
            targetSheet.Name = ws.Name
        End If
    Next ws
    
    ' Break links in the new workbook
    For Each link In wbTarget.LinkSources(xlLinkTypeExcelLinks)
        wbTarget.BreakLink link, xlLinkTypeExcelLinks
    Next link
    
    ' Delete the default "Sheet1" in the new workbook
    Application.DisplayAlerts = False ' Disable alerts
    On Error Resume Next
    wbTarget.Sheets("Sheet1").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True ' Enable alerts
    
    ' Reactivate the source workbook
    wbSource.Activate
    
    ' Enable screen updating
    Application.ScreenUpdating = True
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

 

[rollis13]

Seems to me that your macro errors when it doesn't find links in new workbook, so, try adding these two line to your macro here:

'...
' Break links in the new workbook
If Not IsEmpty(wbTarget.LinkSources(xlLinkTypeExcelLinks)) Then '<- added
    For Each link In wbTarget.LinkSources(xlLinkTypeExcelLinks)
        wbTarget.BreakLink link, xlLinkTypeExcelLinks
    Next link
End If                                        '<- added
' Delete the default "Sheet1" in the new workbook
'...

 

[swapnilk]

Seems to me that your macro errors when it doesn't find links in new workbook, so, try adding these two line to your macro here:

'...
' Break links in the new workbook
If Not IsEmpty(wbTarget.LinkSources(xlLinkTypeExcelLinks)) Then '<- added
    For Each link In wbTarget.LinkSources(xlLinkTypeExcelLinks)
        wbTarget.BreakLink link, xlLinkTypeExcelLinks
    Next link
End If                                        '<- added
' Delete the default "Sheet1" in the new workbook
'...

I tried the modified code as suggested. The code runs without any error but also doesn't copy any of the sheets.

The code modified as under solved the problem.

Sub CopySheetsToNewWorkbook()
    Dim sourceWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim newWorkbook As Workbook
    Dim sheetNames As Variant
    Dim sheetName As Variant
    
    ' Set the source workbook as the active workbook
    Set sourceWorkbook = ActiveWorkbook
    
    ' Specify the sheet names to copy
    sheetNames = Array("SheetNameA", "SheetNameB", "SheetNameC", "SheetNameD", "SheetNameE")
    
    ' Create a new workbook
    Set newWorkbook = Workbooks.Add
    
    ' Copy the specified sheets to the new workbook
    For Each sheetName In sheetNames
        On Error Resume Next
        Set sourceSheet = sourceWorkbook.Sheets(sheetName)
        On Error GoTo 0
        
        If Not sourceSheet Is Nothing Then
            sourceSheet.Copy After:=newWorkbook.Sheets(newWorkbook.Sheets.Count)
        End If
    Next sheetName
    
    ' Delete "Sheet1" in the new workbook
    Application.DisplayAlerts = False ' Disable delete confirmation dialog
    On Error Resume Next ' Ignore error if "Sheet1" doesn't exist
    newWorkbook.Sheets("Sheet1").Delete
    On Error GoTo 0 ' Resume normal error handling
    Application.DisplayAlerts = True ' Enable display of alerts
    
    ' Remove all external links from the new workbook
    For Each link In newWorkbook.LinkSources(xlLinkTypeExcelLinks)
        newWorkbook.BreakLink link, xlLinkTypeExcelLinks
    Next link
    
    ' Activate the new workbook
    newWorkbook.Activate
    
    ' Cleanup
    Set sourceWorkbook = Nothing
    Set sourceSheet = Nothing
    Set newWorkbook = Nothing
    

End Sub

 

[rollis13]

The code runs without any error but also doesn't copy any of the sheets.

The code I modified has nothing to do with sheets, it just avoids breaking links that don't exist wbTarget.BreakLink link, xlLinkTypeExcelLinks which throws an error.
Your new macro is a completely different macro.