Microsoft 365 Comment avoir deux Worksheet_Change en une seule

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

VirginieO

XLDnaute Nouveau
Bonjour,
J'ai créé 2 Sub Worksheet_Change dans le même classeur et un message m'indique qu'un nom ambigu est détecté.
Du coup, je souhaite agréger les deux actions dans la même Sub, mais je j'y arrive pas.
Ci-dessous ce que j'ai créé initialement :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([AR16:AR33], Target) Is Nothing Then
    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox1.List = Sheets("Besoins").Range("A2:A25").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox1.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then Me.ListBox1.Selected(i) = True
      Next i
    End If
    Me.ListBox1.Height = 270
    Me.ListBox1.Width = 520
    Me.ListBox1.Top = Target.Top
    Me.ListBox1.Left = Target.Left + Target.Width
    Me.ListBox1.Visible = True
  Else
      Me.ListBox2.Visible = False
  End If
End Sub

Private Sub ListBox1_Change()
 For i = 0 To Me.ListBox1.ListCount - 1
   If Me.ListBox1.Selected(i) = True Then temp = temp & Me.ListBox1.List(i) & ";"
 Next i
 ActiveCell = Trim(temp)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([AU16:AU33], Target) Is Nothing Then
    Me.ListBox2.MultiSelect = fmMultiSelectMulti
    Me.ListBox2.List = Sheets("Besoins").Range("A2:A25").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox2.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox2.List(i), a, 0)) Then Me.ListBox2.Selected(i) = True
      Next i
    End If
    Me.ListBox1.Height = 270
    Me.ListBox1.Width = 520
    Me.ListBox1.Top = Target.Top
    Me.ListBox1.Left = Target.Left + Target.Width
    Me.ListBox1.Visible = True
  Else
      Me.ListBox2.Visible = False
  End If
End Sub

Private Sub ListBox2_Change()
 For i = 0 To Me.ListBox2.ListCount - 1
   If Me.ListBox2.Selected(i) = True Then temp = temp & Me.ListBox2.List(i) & ";"
 Next i
 ActiveCell = Trim(temp)
End Sub

Et ci-dessous, ce que j'ai tenté de modifier mais qui ne fonctionne pas :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([AR16:AR33], Target) Is Nothing Then
    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox1.List = Sheets("Besoins").Range("A2:A25").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox1.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then Me.ListBox1.Selected(i) = True
      Next i
    End If
    Me.ListBox1.Height = 270
    Me.ListBox1.Width = 520
    Me.ListBox1.Top = Target.Top
    Me.ListBox1.Left = Target.Left + Target.Width
    Me.ListBox1.Visible = True
  Else
      Me.ListBox1.Visible = False
      
      Elself Not Intersect([AU16:AU33], Target)Is Nothing Then
    Me.ListBox2.MultiSelect = fmMultiSelectMulti
    Me.ListBox2.List = Sheets("Besoins").Range("A2:A25").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox2.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox2.List(i), a, 0)) Then Me.ListBox2.Selected(i) = True
      Next i
    End If
    Me.ListBox2.Height = 270
    Me.ListBox2.Width = 520
    Me.ListBox2.Top = Target.Top
    Me.ListBox2.Left = Target.Left + Target.Width
    Me.ListBox2.Visible = True
  Else
      Me.ListBox2.Visible = False
  Else
  Exit Sub
 
  End If
End Sub

Private Sub ListBox1_Change()
 For i = 0 To Me.ListBox1.ListCount - 1
   If Me.ListBox1.Selected(i) = True Then temp = temp & Me.ListBox1.List(i) & ";"
 Next i
 ActiveCell = Trim(temp)
End Sub

Private Sub ListBox2_Change()
 For i = 0 To Me.ListBox2.ListCount - 1
   If Me.ListBox2.Selected(i) = True Then temp = temp & Me.ListBox2.List(i) & ";"
 Next i
 ActiveCell = Trim(temp)
End Sub

En vous remerciant pour votre aide,

VirginieO
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
549
Réponses
3
Affichages
833
Réponses
10
Affichages
530
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
8
Affichages
646
Réponses
5
Affichages
703
Retour