Microsoft 365 Comment avoir deux Worksheet_Change en une seule

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
 

Discussions similaires

Réponses
4
Affichages
209
Réponses
17
Affichages
826

Statistiques des forums

Discussions
312 198
Messages
2 086 145
Membres
103 130
dernier inscrit
FRCRUNGR