PB:(VBA) _Change(ByVal Target As Range) 2 liste automatique

Le 20/08/2013 à 22:33

Bonjours et merci de toute forme d'aide que vous saurez m’indiquer.

J'éprouve un problème peut être un peu compliqué

En gros j'ai 2 cellules qui contiennent une liste différente (H9) et (J9)

Pour l’instant lorsque je sélectionne dans la liste de (H9), celui si rempli automatiquement les cellules ((J9),K9,L9 et M9) avec les informations de la feuille (No dossier AaZ)

Le problème survient lorsque je choisi dans la liste de (J9), il remplit automatiquement K9,L9,M9, mais j’aimerai que celui si puisse aussi remplir (H9) ! , le problème ses que lorsque j’essaie ça ne marche pas, sa bug et j’ai un code d’erreur !

En gros vous voyez un peu mon souci (loop infinie) , je peux soi faire que (H9) rempli toute les cellules ou sois (J9) fasse pareil mais, pas les 2 en même temps, ses réalisable, ya surement une méthode !

Je vous donne mon scripte VB, et le gestionnaire de nom ainsi que une aperçu en image.

Au besoin je peux vous fournir une copie du fichier Excel

029800522 image562 122 227lo 029805306 image415 122 1136lo

Code VB

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adres As Range, Dl As Long
If Target.Row >= 9 And Target.Row <= 23 And Target.Column = 8 Then
  With Sheets("ADRESSE AaZ")
    Dl = .Range("A" & .Rows.Count).End(xlUp).Row
    Set adres = .Range("A2:A" & Dl).Find(Target.Value)
  End With
  If Not adres Is Nothing Then
    Range("J" & Target.Row) = adres(1, 3)
    Range("K" & Target.Row) = adres(1, 4)
    Range("L" & Target.Row) = adres(1, 5)
    Range("M" & Target.Row) = adres(1, 2)

  End If
End If
If Target.Row >= 9 And Target.Row <= 23 And Target.Column = 10 Then
  With Sheets("ADRESSE AaZ")
    Dl = .Range("C" & .Rows.Count).End(xlUp).Row
    Set adres = .Range("C2:C" & Dl).Find(Target.Value)
  End With
  If Not adres Is Nothing Then
    Range("K" & Target.Row) = adres(1, 2)
    Range("L" & Target.Row) = adres(1, 3)
    Range("M" & Target.Row) = adres(1, 0)

  End If
End If
End Sub

Gestionnaire de nom

=DECALER('ADRESSE AaZ'!$C$2;;;NBVAL('ADRESSE AaZ'!$C:$C)-1)

ET

=DECALER('No Dossier AaZ'!$A$2;;;NBVAL('No Dossier AaZ'!$A:$A)-1)

Jai joint le fichier complet si vous avez une idée !!

Le 20/08/2013 à 22:52

Bonjour,

si j'ai bien suivi ton pb il faudrait que tu interrompes les évènements avec :

Application.EnableEvents = False

Les rétablir en fin de macro avec =true.

eric

Le 20/08/2013 à 23:05

Salut éric et merci de t'intéresser a mon cas personnelle, ta réponse me semble plutôt logique, , mais je ne saurai pas ou l'appliquer je suis plutôt en début d'apprentissage avec le vba.

Esceque tu saura m'envoyer une copy du code avec ces ajout svpl.

Voici la ligne qui cause problème lorsque je l'ajoute

Range("H" & Target.Row) = adres(1, -1)

L'onglet (H9) ce renseigne , mais Jai une message qui apparait (débogage )!!

Voici le code final complet avec le bug de looping !, tout marche mais Jai un message d'erreur de débogage !!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adres As Range, Dl As Long
If Target.Row >= 9 And Target.Row <= 23 And Target.Column = 8 Then
  With Sheets("ADRESSE AaZ")
    Dl = .Range("A" & .Rows.Count).End(xlUp).Row
    Set adres = .Range("A2:A" & Dl).Find(Target.Value)
  End With
  If Not adres Is Nothing Then
    Range("J" & Target.Row) = adres(1, 3)
    Range("K" & Target.Row) = adres(1, 4)
    Range("L" & Target.Row) = adres(1, 5)
    Range("M" & Target.Row) = adres(1, 2)

  End If
End If
If Target.Row >= 9 And Target.Row <= 23 And Target.Column = 10 Then
  With Sheets("ADRESSE AaZ")
    Dl = .Range("C" & .Rows.Count).End(xlUp).Row
    Set adres = .Range("C2:C" & Dl).Find(Target.Value)
  End With
  If Not adres Is Nothing Then
    Range("K" & Target.Row) = adres(1, 2)
    Range("L" & Target.Row) = adres(1, 3)
    Range("M" & Target.Row) = adres(1, 0)
    Range("H" & Target.Row) = adres(1, -1)

  End If
End If
End Sub
Le 20/08/2013 à 23:28

Bonsoir,

Si j'ai bien compris...

Option Explicit
Dim BlockChange As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adres As Range, Dl As Long
  If BlockChange Then Exit Sub
  BlockChange = True
  Application.ScreenUpdating = False
    If Target.Row >= 9 And Target.Row <= 23 And Target.Column = 8 Then
      With Sheets("ADRESSE AaZ")
        Dl = .Range("A" & .Rows.Count).End(xlUp).Row
        Set adres = .Range("A2:A" & Dl).Find(Target.Value)
      End With
      If Not adres Is Nothing Then
        Range("J" & Target.Row) = adres(1, 3)
        Range("K" & Target.Row) = adres(1, 4)
        Range("L" & Target.Row) = adres(1, 5)
        Range("M" & Target.Row) = adres(1, 2)
      End If
    End If
    If Target.Row >= 9 And Target.Row <= 23 And Target.Column = 10 Then
      With Sheets("ADRESSE AaZ")
        Dl = .Range("C" & .Rows.Count).End(xlUp).Row
        Set adres = .Range("C2:C" & Dl).Find(Target.Value)
      End With
      If Not adres Is Nothing Then
        Range("K" & Target.Row) = adres(1, 2)
        Range("L" & Target.Row) = adres(1, 3)
        Range("M" & Target.Row) = adres(1, 0)
        Range("H" & Target.Row) = adres(1, -1)
      End If
    End If
  BlockChange = False
  Set adres = Nothing
End Sub

Cdt,

Darzou

Le 20/08/2013 à 23:42

Cool '! toutes est fictionnelles maintenant, jai plus le message d'erreur, merci a vous 2 , vous ete des pro !!

Rechercher des sujets similaires à "vba change byval target range liste automatique"