Double test avec des cellules renommées

Bonjour,

Malgré plusieurs tentatives et recherche, je ne parviens à trouver la solution de mon problème.

J'ai renommé des cellules dans certaines feuilles de mon classeur en "TAV" et "ADSP". La cellule TAV doit être copié dans la cellule ADSP pour chaque feuille slectionné dans une listbox. Jusqu'ici, j'étais bon.

J'aimerais maintenant introduire un double test, la présence de TAV et ADSP dans la feuille selectionnée. Et c'est à cet endroit que je bloque. Je ne suis pas certain d'identifier mon problème (le déroulé de la procédure, la référence à ma cellule renommée ?) car je n'ai pas de message d'erreur mais en tout cas ça ne marche pas...

Dim selection As Range
Dim selection2 As Range
str_search1 = Range("TAV")
str_search2 = Range("ADSP")

        With ListBox1
        For I = 0 To .ListCount - 1
            If .Selected(I) Then

            Set selection = Sheets(ListBox1.List(I)).Range("A:H").Find(str_search, , xlValues, xlWhole)
            Set selection2 = Sheets(ListBox1.List(I)).Range("A:H").Find(str_search2, , xlValues, xlWhole)

            If selection Is Nothing Then
            Exit Sub

            If selection2 Is Nothing Then
            Exit Sub

            Else
            Sheets(ListBox1.List(I)).Range("TAV").Copy
            Sheets(ListBox1.List(I)).Range("ADSP").PasteSpecial Paste:=xlPasteValues

Sheets(ListBox1.List(I)).Range("ADSP") = Sheets(ListBox1.List(I)).Range("ADSP") * -1

End If
End If
End If
Next I

End With

Merci beaucoup pour votre aide et explication si possible.

Maxime

bonjour,

une proposition, mais je n'ai pas réellement saisi la finalité, donc il se peut que j'aie mal compris. (non testé)

    Dim i As Long
    Dim sel1 As Range, sel2 As Range
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Set sel1 = Nothing
                Set sel2 = Nothing
                On Error Resume Next
                Set sel1 = Application.Intersect(Sheets(ListBox1.List(i)).Range("TAV"), Sheets(ListBox1.List(i)).Range("A:H")) 'vérifie si une cellule nommée TAV est présente dans les colonnes A:H de la feuille choisie
                Set sel2 = Application.Intersect(Sheets(ListBox1.List(i)).Range("ADSP"), Sheets(ListBox1.List(i)).Range("A:H")) 'vérifie si une cellule nommée ADSP est présente dans les colonnes A:H de la feuille choisie
                On Error GoTo 0
                If sel1 Is Nothing Then
                    Exit Sub
                End If
                If sel2 Is Nothing Then
                    Exit Sub
                End If
                Sheets(ListBox1.List(i)).Range("TAV").Copy
                Sheets(ListBox1.List(i)).Range("ADSP").PasteSpecial Paste:=xlPasteValues
                Sheets(ListBox1.List(i)).Range("ADSP") = Sheets(ListBox1.List(i)).Range("ADSP") * -1
            End If
        Next i
    End With

Merci pour votre aide, malheuresement aprés test, cela ne marche pas.

Je pense modifier un peu la procédure en effectuant la recherche sur toutes les feuilles de mon fichier plutôt que sur celles selectionnées dans ma listbox.

Pour expliquer ma tentative, je cherche dans toutes les feuilles du fichier s'il y a par feuille une cellule nommée "Ex1" et une autre nommée "Ex2". Si ces deux conditions sont remplies, alors dans chaque feuille concernée, je copie la cellule "Ex1" dans "Ex2". Si les deux conditions ne sont pas remplies, je quitte la fonction.

Je continue mes recherches :)

bonjour,

dans ce cas,

Sub aargh()
    Dim i As Long
    Dim sel1 As Range, sel2 As Range
    For Each ws In Worksheets
        Set sel1 = Nothing
        Set sel2 = Nothing
        On Error Resume Next
        Set sel1 = ws.Range("TAV") 'vérifie si une cellule nommée TAV est présente sur la feuille ws
        Set sel2 = ws.Range("ADSP") 'vérifie si une cellule nommée ADSP est présente sur la feuille ws
        On Error GoTo 0

        If sel1 Is Nothing Then Exit For

        If sel2 Is Nothing Then Exit For

        ws.Range("TAV").Copy
        ws.Range("ADSP").PasteSpecial Paste:=xlPasteValues
        ws.Range("ADSP") = ws.Range("ADSP") * -1
    Next
End Sub

Merci beaucoup pour votre aide, malheuresement cela ne marche toujours pas. J'ai préparé un fichier test si cela peut aider. Je ne parviens pas à identifier le problème..

bonsoir,

merci pour le fichier. ceci devrait fonctionner.

Private Sub Test_Click()
    Dim i As Long
    Dim sel1 As Range, sel2 As Range

    For Each ws In Worksheets
        Set sel1 = Nothing
        Set sel2 = Nothing
        On Error Resume Next
        Set sel1 = ws.Range("TAV") 'vérifie si une cellule nommée TAV est présente sur la feuille ws
        Set sel2 = ws.Range("ADSP") 'vérifie si une cellule nommée ADSP est présente sur la feuille ws
        On Error GoTo 0

        If Not (sel1 Is Nothing Or sel2 Is Nothing) Then
            ws.Range("TAV").Copy
            ws.Range("ADSP").PasteSpecial Paste:=xlPasteValues
            ws.Range("ADSP") = ws.Range("ADSP") * -1
        End If
    Next

    MsgBox "C'est terminé"
End Sub

bonjour h2so4 et Monroe,

peut-être simplement avec cette macro (j'ai copié et collé les dernières lignes de h2so4). La macro doit se trouver dans un module normal, je pense que cela ne fonctionne pas dans le module d'une feuille ou un UF.

Sub teste()
     If Range("TAV").Parent.Name <> Range("ADSP").Parent.Name Then
          MsgBox "les 2 plages ne sont pas dans la même feuille", vbCritical
     Else
          Range("TAV").Copy
          With Range("ADSP")
               .PasteSpecial Paste:=xlPasteValues
               .Value = .Value * -1
          End With
     End If
End Sub

Cela fonctionne parfaitement, merci infiniment pour votre aide.

J'ai juste tester le code mais je vais maintenant essayer de l'analiser pour continuer mon apprentissage !! :)

Maxie

re,

"Normallement", le "scope" d'une plage nommée, c'est le fichier mais la feuille est aussi possible, par exemple pour déterminer la plage pour imprimer. Je ne sais pas mieux vous expliquer, sorry.

Mais si le scope de la plage nommée est le fichier (=werkmap), alors on peut demander le nom du "parent" et le parent d'une plage, c'est la feuille. Dans l'image ici dessous, "adrukbereik" c'est la plage pour imprimer et vous voyez que c'est le même nom (réservé) pour chaque feuille mais avec un "scope" différent.

Peut-être, une autre personne sait mieux l'expliquer ...