Tool to map relationships between worksheets in the same workbook

the following code

Sub Svyazi()
' выводит на новый лист все внешние связи и между листами книги
' code creates a list of all links between sheets and exrernal links
Dim spisws()
Dim spiscell()
Dim spl()
Dim spce()
Dim splni()
Dim i, j, ii, iii, nl
Dim iLinks As Variant
Dim ws As Worksheet
Dim rr As Range
Dim cell As Range
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim rlastf
Dim fff
Dim nml
Dim bNewArrow As Boolean
Application.ScreenUpdating = False
'внешние связи
iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(iLinks) Then
nl = UBound(iLinks)
End If

For Each ws In Sheets
ws.Select
On Error Resume Next
Set rr = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
If Err.Number = 0 Then
On Error GoTo 0
'seach external links
For Each cell In rr
    If Not IsEmpty(nl) Then
        If InStr(cell.Formula, "[") > 0 Then
            rlastf = Replace(cell.Formula, "[", "")
  For iii = 1 To nl
    If InStr(rlastf, iLinks(iii)) > 0 Then
                i = i + 1
            ReDim Preserve splni(0 To i)
            ReDim Preserve spl(0 To i)
            ReDim Preserve spce(0 To i)
            ReDim Preserve spisws(0 To i)
            ReDim Preserve spiscell(0 To i)
            
                spl(i) = ws.Name
                spce(i) = cell.Address(False, False, xlA1)
                splni(i) = iLinks(iii)
        End If

            Next iii
    End If
End If
'search links between sheets
    cell.Select
    ActiveCell.ShowPrecedents
    Set rLast = ActiveCell
    iArrowNum = 1
    iLinkNum = 1
    bNewArrow = True
Do
    Do
    Application.Goto rLast
        On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
        If Err.Number > 0 Then Exit Do
            On Error GoTo 0
                If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
                    bNewArrow = False
                        If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
                            If rLast.Worksheet.Name <> ActiveCell.Parent.Name Then '
                    i = i + 1
            ReDim Preserve splni(0 To i)
            ReDim Preserve spl(0 To i)
            ReDim Preserve spce(0 To i)
            ReDim Preserve spisws(0 To i)
            ReDim Preserve spiscell(0 To i)
 
                spl(i) = ws.Name
                spce(i) = rLast.Address(False, False, xlA1)
                spisws(i) = Selection.Parent.Name
                spiscell(i) = Selection.Address(False, False, xlA1)


        End If
    End If
        iLinkNum = iLinkNum + 1 ' перебор аргументов
    Loop
        If bNewArrow Then Exit Do
            iLinkNum = 1
            bNewArrow = True
            iArrowNum = iArrowNum + 1
    Loop
        rLast.Parent.ClearArrows
        Application.Goto rLast

Next cell


        Set rr = Nothing
    End If
        Next ws
'вывод данных
Sheets.Add
nml = Application.InputBox("new sheet name?")
ActiveSheet.Name = nml
Sheets(nml).Move Before:=Sheets(1)
 
Range(Cells(1, 2), Cells(i + 1, 2)) = Application.WorksheetFunction.Transpose(spce)
Range(Cells(1, 3), Cells(i + 1, 3)) = Application.WorksheetFunction.Transpose(splni)

Range(Cells(1, 5), Cells(i + 1, 5)) = Application.WorksheetFunction.Transpose(spiscell)
Range(Cells(1, 1), Cells(1, 6)) = Array("лист", "ячейка", "внешняя ссылка", "лист ссылки", "ячейки ссылки", "примечание")
    Range("A1:F1").AutoFilter
    Range("B2").Select
    ActiveWindow.FreezePanes = True
'для внешних связей проверка существования файла и создание гиперссылки на него, создание гиперссылок на листы
' for external links check up if file exists. creating hyperlinks
    For j = 1 To i
    If Not IsEmpty(Cells(j + 1, 3)) Then
    Set fff = CreateObject("Scripting.FileSystemObject")
    If fff.FileExists(Cells(j + 1, 3).Value) Then
     Set fff = Nothing
            Worksheets(nml).Hyperlinks.Add Anchor:=Cells(j + 1, 3), Address:=Cells(j + 1, 3).Value
     
     Else
     Cells(j + 1, 3) = "Beaten link"
     End If
    
     End If
             Worksheets(nml).Hyperlinks.Add Anchor:=Cells(j + 1, 1), Address:="", SubAddress:="'" & spl(j) & "'" & "!" & spce(j)
         Cells(j + 1, 1).Formula = spl(j)
             Worksheets(nml).Hyperlinks.Add Anchor:=Cells(j + 1, 4), Address:="", SubAddress:="'" & spisws(j) & "'" & "!A1"
         Cells(j + 1, 4).Formula = spisws(j)
         
    Next j
    Cells.Columns.AutoFit
    With Cells
        .VerticalAlignment = xlTop
        .WrapText = True
    End With

Application.ScreenUpdating = True
End Sub

this part is important

Range(Cells(1, 5), Cells(i + 1, 5)) = Application.WorksheetFunction.Transpose(spiscell)
Range(Cells(1, 1), Cells(1, 6)) = Array("sheet", "depended cell", "external links/path", "source sheet", "source range", "comment")

Is there a easy way to modify this to show each link between two worksheets once?

not clear what you want

Currently the macro gives me a new worksheet with over 20,000 rows. I'd prefer a list that shows each worksheet, and one row for each of the worksheets it reaches out to for data. As an example assuming two columns;
Sheet 1 Sheet 3
Sheet 1 Sheet 5
Sheet 1 Sheet 9
Sheet 1 Sheet 11
Sheet 2 Sheet 5
Sheet 2 Sheet 6
Sheet 2 Sheet 12
Sheet 3 Sheet 4
Sheet 3 Sheet 7
Sheet 3 Sheet 8
I'm currently paring it down with a pivot table but the result isn't exactly what I'm looking for
Thanks much,
Bill