Option Explicit 
 
Sub FormatOtherSheetLinks() 
    Dim TestRange As Range, C As Range, MyRange As Range 
    Dim FirstAddress As String, SheetString As String 
    Dim wsh As Worksheet 
     
    On Error Resume Next 
     'look at formulas only. There may be no formulas in the sheet
    Set TestRange = Cells.SpecialCells(xlCellTypeFormulas) 
    On Error GoTo 0 
     
    If Not TestRange Is Nothing Then 
        For Each wsh In ActiveWorkbook.Worksheets 
            SheetString = wsh.Name & "*!" 
             'deal with those messy quotes
            SheetString = Replace(SheetString, "'", "''") 
            With TestRange 
                 'look in formulas for a sheet name match
                Set C = .Find(SheetString, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False) 
                If Not C Is Nothing Then 
                    FirstAddress = C.Address 
                    If MyRange Is Nothing Then Set MyRange = C 
                    Do 
                        Set C = .FindNext(C) 
                        If Not MyRange Is Nothing Then Set MyRange = Union(MyRange, C) 
                    Loop Until C.Address = FirstAddress 
                End If 
            End With 
        Next 
         'Colour all linked cells with a blue interior
        If Not MyRange Is Nothing Then MyRange.Interior.Color = vbBlue 
    End If 
     
    Set TestRange = Nothing 
    Set MyRange = Nothing 
End Sub