Reperer les dépendants sur une autre feuille

Bonjour à tous,

je possède un fichier excel contenant de nombreuses formules réparties sur plusieurs feuilles. Dans ce fichier j'ai défini des nom pour plusieurs cellules.

Mon problème et que lorsque je souhaite "repérer les dépendants" d'une cellule définie par un nom sur la feuille1, cela n'est pas possible si ceux-ci se trouvent sur une autre feuille. (ca fait une flèche en pointiller avec un petit tableau).

Je souhaiterai aussi savoir s'il existe un moyen de trouver toutes les cellules utilisant une cellule donnée quelque soit l'endroit où elles se trouvent dans le classeur?

Peut-on faire une macro qui permet de lister toutes ces cellules?

Bien cordialement,

Max

Bonjour

Un code de Banzai

Option Explicit

Sub RechercheNomsDefinis()
Dim I As Integer, K As Integer
Dim Cel As Range
Dim Depart As String
Dim Ok As Boolean
Dim Nb As Integer
Dim ListeNoms

  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("Liste des noms").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True

  ReDim ListeNoms(1 To 3, 1 To 1)
  With ActiveWorkbook
    For I = 1 To .Names.Count
    Ok = False
      If .Names(I).Visible Then
        For K = 1 To Sheets.Count
          Set Cel = Sheets(K).Cells.Find(what:=.Names(I).Name, LookIn:=xlFormulas, lookat:=xlPart)
          If Not Cel Is Nothing Then
            Depart = Cel.Address
            Do
              Ok = True
              Nb = Nb + 1
              ReDim Preserve ListeNoms(1 To 3, 1 To Nb)
              ListeNoms(1, Nb) = .Names(I).Name
              ListeNoms(2, Nb) = Sheets(K).Name
              ListeNoms(3, Nb) = Cel.Address
              Set Cel = Sheets(K).Cells.FindNext(Cel)
            Loop While Cel.Address <> Depart
          End If
        Next K
        If Ok = False Then
          Nb = Nb + 1
          ReDim Preserve ListeNoms(1 To 3, 1 To Nb)
          ListeNoms(1, Nb) = .Names(I).Name
          ListeNoms(2, Nb) = "NOM DEFINI NON UTILISE !"
        End If
      End If
    Next I
  End With

  If Nb = 0 Then
    MsgBox "Aucun nom défini dans ce classeur"
  Else
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Liste des noms"
    Range("A1:C1") = Array("Nom", "Feuille", "Cellule")
    Range("A2").Resize(Nb, 3) = Application.Transpose(ListeNoms)
    Columns("A:C").AutoFit
  End If
End Sub

Amicalement

Nad

Merci pour ce code de banzai, il est parfait.

Dans la 4ème colonne, je souhaite indiquer les formules de la cellule indiquée, pourrais tu me donner un petit coup de main pour l'intégrer à ce code vba?

Encore une question

Mon fichier semble trop conséquent pour que tout puisse s'afficher; je reçoit un message d'erreur "Dépassement de capacité" au bout de quelque minutes de travail intense de mon PC.

Pour palier à ce problème, on peut par exemple le faire feuille par feuille en créant une nouvelle liste pour chaque feuille ou bien sélectionner les feuilles que l'on souhaite utiliser

Ca vous parait faisable?

Merci par avance

Re

Essaye avec ce code qui devrait régler le problème de dépassement de capacité également

Option Explicit

Sub RechercheNomsDefinis()
Dim I As Long, K As Long
Dim Cel As Range
Dim Depart As String
Dim Ok As Boolean
Dim Nb As Long
Dim ListeNoms

Application.ScreenUpdating = False

  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("Liste des noms").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True

  ReDim ListeNoms(1 To 4, 1 To 1)
  With ActiveWorkbook
    For I = 1 To .Names.Count
    Ok = False
      If .Names(I).Visible Then
        For K = 1 To Sheets.Count
          Set Cel = Sheets(K).Cells.Find(what:=.Names(I).Name, LookIn:=xlFormulas, lookat:=xlPart)
          If Not Cel Is Nothing Then
            Depart = Cel.Address
            Do
              Ok = True
              Nb = Nb + 1
              ReDim Preserve ListeNoms(1 To 4, 1 To Nb)
              ListeNoms(1, Nb) = .Names(I).Name
              ListeNoms(2, Nb) = Sheets(K).Name
              ListeNoms(3, Nb) = Cel.Address
              ListeNoms(4, Nb) = " " & .Names(I).RefersTo
              Set Cel = Sheets(K).Cells.FindNext(Cel)
            Loop While Cel.Address <> Depart
          End If
        Next K
        If Ok = False Then
          Nb = Nb + 1
          ReDim Preserve ListeNoms(1 To 3, 1 To Nb)
          ListeNoms(1, Nb) = .Names(I).Name
          ListeNoms(2, Nb) = "NOM DEFINI NON UTILISE !"
        End If
      End If
    Next I
  End With

  If Nb = 0 Then
    MsgBox "Aucun nom défini dans ce classeur"
  Else
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Liste des noms"
    Range("A1:D1") = Array("Nom", "Feuille", "Cellule", "Formule")
    Range("A2").Resize(Nb, 4) = Application.Transpose(ListeNoms)
    Columns("A:D").AutoFit
  End If
End Sub

Nad

Merci à toi, tu avais oublié de changer un 3 en 4 dans le code, je l'ai modifié

Ca fonctionne pour certains fichiers par contre pour d'autres plus gros, j'ai le messages d'erreur en pièce jointe et lorsque je fait débogage j'arrive sur la ligne surlignée en pièce jointe 2.

Ca ne doit pas être grand chose, une petite erreur de syntaxe ?

Re

Ben là je sèche.

Désolée

Amicalement

Nad

C'est pas grave, ca m'aide tout de même beaucoup

Merci encore

Bonsoir à vous, on m'a transmis un autre code qui fonctionne vraiment bien

A celui-ci, j'ai rajouté une ligne afin d'obtenir la colonne donnant le résultat des formules par contre quelqu'un saurait faire en sorte que celui-ci fasse les chose suivantes:

• lister les formules de chaque feuille sur une nouvelle feuille: par exemple que les informations de la feuille 1 soient listées sur une feuille "liste feuille 1", la feuille 2 sur une feuille "liste feuille 2" etc. (du coup on n'aura plus besoin de la ligne .Cells(X, 1) = F.Name)
• mettre des titres aux tableaux créer dans chaque nouvelle feuille: Nom, formule, résultat

Ci-joint le code:

Private Sub CommandButton1_Click()
 Dim F As Worksheet, C As Range, CTest As Range, X&
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
 With Sheets("Formules")
      .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(1, 2)).ClearContents
      For Each F In Worksheets
          If F.Name <> .Name Then
              Set CTest = F.Cells.Find("=", , xlFormulas)
              If Not CTest Is Nothing Then
                  For Each C In F.Cells.SpecialCells(xlCellTypeFormulas)
                      If Left(C.Formula, 1) = "=" Then
                          X = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                          .Cells(X, 1) = F.Name
                          .Cells(X, 2) = C.Address
                          .Cells(X, 3) = "'" & C.FormulaLocal
                          .Cells(X, 4) = C.Formula
                      End If
                  Next C
                  Set CTest = Nothing
              End If
          End If
      Next F
 End With
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox "Traitement terminé", , "Compte-rendu"
 End Sub

Cdt,

Maxdhavys