Problème code VBA

Bonjour, Un membre a gentiment répondu à mon appel à l'ide mais le code VBA indiqué comporte des erreurs. Par conséquent cela ne fonctionne malheureusement pas Pourriez-vous m'aider je vous prie

bonjour,

Modifiez comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr, i&
Arr = Worksheets("Liste").[A1].CurrentRegion.Value
 If Not Application.Intersect(Target, Range("G1:G10000")) Is Nothing Then
 For i = 1 To UBound(Arr)
 If Arr(i, 1) = Target.Value Then
     Cells(Target.Row, 8).Value = Arr(i, 2)
     Cells(Target.Row, 9).Value = Arr(i, 4)
     Cells(Target.Row, 10).Value = Arr(i, 3)
     Exit For
   End If
 Next
End If
End Sub

A+

Salut Galopin !

Bonjour,

Même sujet qu'ici non ? https://forum.excel-pratique.com/excel/remplissage-auto-si-selection-d-une-ref-dans-un-des-3-menus-d...

Pouvez-vous cloturer vos fils si terminés ? ->

Merci de mettre votre profil à jour en mentionnant votre version Excel. Cela peut aussi aider le répondeur à vos demandes

Crdlt

Je suis heureux de te dire que chez moi ça fonctionne ! Mal, j'en conviens mais ça fonctionne.

Donc plus tu recommences plus tu as de chance de réussir (Proverbe Shadock !)

Ça ne fonctionne pas n'est pas une réponse : Il se passe forcément quelque chose mais ce n'est pas le résultat attendu ?

Décrire ce qu'il se passe et décrire ce qui ne se passe pas bien (imprim Ecran)

Décrire ta config dans ton profil.

Alors j'ai relu la question ou plutôt les commentaires du classeur...

Ce n'est pas possible d'avoir un résultat sur les colonne i et J car elles contiennent des doublons.

En revanche la macro suivante fonctionne sur les références et les libellés.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr, i&
Arr = Worksheets("Liste").[A1].CurrentRegion.Value
    If Not Application.Intersect(Target, Range("G1:G10000")) Is Nothing Then
        For i = 1 To UBound(Arr)
           If Arr(i, 1) = Target.Value Then
               Application.EnableEvents = False
               Cells(Target.Row, 8).Value = Arr(i, 2)
               Cells(Target.Row, 9).Value = Arr(i, 4)
               Cells(Target.Row, 10).Value = Arr(i, 3)
               Application.EnableEvents = True
           Exit For
           End If
        Next
    End If
    If Not Application.Intersect(Target, Range("H1:H10000")) Is Nothing Then
       For i = 1 To UBound(Arr)
          If Arr(i, 2) = Target.Value Then
              Application.EnableEvents = False
              Cells(Target.Row, 7).Value = Arr(i, 1)
              Cells(Target.Row, 9).Value = Arr(i, 4)
              Cells(Target.Row, 10).Value = Arr(i, 3)
              Application.EnableEvents = True
              Exit For
          End If
       Next
    End If
End Sub

A+