Boucle toutes les valeurs de la colonne A pour trouver tous les matchs de la colonne B

Mon code trouve toutes les connexions internes dans un classeur externe, trouve toutes les feuilles cachées.

Ce que j'aimerais réaliser grâce à ces valeurs consiste à supprimer toutes les feuilles cachées qui ne sont pas des sources pour toute autre feuille de classeur. P>

Je sais que cela devrait être fait avec une boucle imbriquée, mais j'ai des problèmes de construire cela. p>

p> xxx pré >

J'ai testé les trois réponses, rien ne se passe dans le code de code. p>

Code complet à examiner: P>

Sub a()

Dim xSheet As Worksheet
Dim xRg As Range
Dim xCell As Range
Dim xCount As Long
Dim xLinkArr() As String
Dim wbmacro As Workbook
Dim wbtarget As Workbook
Dim strfile As String
Dim strpath As String
Dim filename As String
Dim hsheet As String

Set wbmacro = ActiveWorkbook
filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx")

Set wbtarget = Workbooks.Open(filename, UpdateLinks:=0)
        
On Error Resume Next

For Each xSheet In wbtarget.Sheets
    
    Set xRg = xSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    If xRg Is Nothing Then GoTo LblNext
    For Each xCell In xRg
        If InStr(1, xCell.Formula, "!") > 0 Then
            xCount = xCount + 1
            ReDim Preserve xLinkArr(1 To 2, 1 To xCount)
            xLinkArr(1, xCount) = xCell.Address(, , , True)
            xLinkArr(2, xCount) = "'" & xCell.Formula
       End If
    Next

LblNext:
Next

If xCount > 0 Then
    wbmacro.Activate
    wbmacro.Sheets("Link Sheet").Activate
    Range("A1").Resize(, 3).Value = Array("Location", "Reference", "Reference Sheet Name")
    Range("A2").Resize(UBound(xLinkArr, 2), UBound(xLinkArr, 1)).Value = Application.Transpose(xLinkArr)
    Columns("A:D").AutoFit
Else
    MsgBox "No links were found within the active workbook.", vbInformation
End If

x = 2
For Each ws In wbtarget.Worksheets
    If ws.Visible = xlSheetHidden Then
        wbmacro.Sheets("Link Sheet").Cells(x, 4) = ws.Name
        x = x + 1
    End If
Next ws

wbmacro.Activate
Columns("A:C").Select
ActiveSheet.Range("$A$1:$B$758").RemoveDuplicates Columns:=1, Header:=xlNo

Dim rc As Range
For Each c In wbmacro.Sheets("Link Sheet").Range("D2:D10").Cells
    ' The default behaviour is to delete the sheet
    bDeleteSheet = True
    For Each rc In wbmacro.Sheets("Link Sheet").Range("C2:C10").Cells
        If c.Value = rc.Value Then
            ' If you find the sheet name then it is used
            ' Do NOT delete it
            bDeleteSheet = False
            Exit For
        End If
    Next
    If bDeleteSheet Then wbtarget.Sheets(c).Delete
Next

End Sub