'参照元トレース(複数セル)マクロ

'セル範囲を選択してShowPrecedentsAllマクロを実行してください。

Option Explicit

Sub ShowPrecedentsAll()
    Const myTitle As String = "参照元トレース"
    Dim r As Range

    If TypeName(Selection) <> "Range" Then Exit Sub
    On Error GoTo err_1
    Application.ScreenUpdating = False
    With Selection
        If .Cells.Count = 1 Then
            If .HasFormula Then
                .ShowPrecedents
            Else
                On Error GoTo err_2
                Error 1004
            End If
            Exit Sub
        End If
        On Error GoTo err_2
        .SpecialCells(xlFormulas).Select
        On Error GoTo err_1
    End With
    For Each r In Selection.Cells
        r.ShowPrecedents
    Next
    Exit Sub
err_1:
    MsgBox Error(Err) & " (" & Err & ")", vbExclamation, myTitle
    Exit Sub
err_2:
    If Err = 1004 Then
        MsgBox "選択範囲に数式はありません。", vbExclamation, myTitle
    Else
        MsgBox Error(Err) & " (" & Err & ")", vbExclamation, myTitle
    End If
End Sub