Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble

[BenExcel]

Bonjour à tous,
Je me tourne vers vous car mes connaissances en VBA sont proches de 0.
J'ai créé un outil type "CVthèque" dans lequel je souhaite faire cohabiter 2 codes VBA (trouvés sur le net) dans la même feuille :

- Le premier code qui fonctionne et que j'utilise, me permet d'attribuer automatique un "ID" pour chaque entretien que je réalise.
- Le second code que j'ai trouvé sur le net, celui que je veux rajouter en plus, me permet de choisir plusieurs choix dans mes listes déroulantes (en fait c'est surtout pour une seule colonne : la "H" bassin de l'emploi dans laquelle j'ai plusieurs choix à renseigner dans mes cellules). Ps : le code est un peu "rustine" car il applique ces choix multiples à toutes les listes déroulantes de la feuille et non de cette colonne. Bref ça répond tout de même à mon besoin.

J'ai déjà le premier code qui tourne depuis un bout de temps sur ma feuille et dont je suis satisfait.
J'aimerais maintenant rajouter le seconde code et c'est là que je bloque, je n'y arrive pas !!

Pourriez-vous m'aider ?


Voici le 1er code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
If IsEmpty(Target.Offset(0, -1)) Then
With Sheets("ID").Cells(1, 1)
Target.Offset(0, -1).Value = .Value
.Value = .Value + 1
End With
End If
End If
End Sub



Voici le 2nd :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim delimiter As String
Dim TargetRange As Range

Set TargetRange = Me.UsedRange ' Users can change target range here
delimiter = ", " ' Users can change the delimiter here

If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
On Error Resume Next
Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False

xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" And xValue2 <> "" Then
If Not (xValue1 = xValue2 Or _
InStr(1, xValue1, delimiter & xValue2) > 0 Or _
InStr(1, xValue1, xValue2 & delimiter) > 0) Then
Target.Value = xValue1 & delimiter & xValue2
Else
Target.Value = xValue1
End If
End If

Application.EnableEvents = True
On Error GoTo 0
End Sub



Merci d'avance!

 

[piga25]

Bonjour,
Peut être comme cela:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
If IsEmpty(Target.Offset(0, -1)) Then
With Sheets("ID").Cells(1, 1)
Target.Offset(0, -1).Value = .Value
.Value = .Value + 1
End With
End If
End If

Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim delimiter As String
Dim TargetRange As Range

Set TargetRange = Me.UsedRange ' Users can change target range here
delimiter = ", " ' Users can change the delimiter here

If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
On Error Resume Next
Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False

xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" And xValue2 <> "" Then
If Not (xValue1 = xValue2 Or _
InStr(1, xValue1, delimiter & xValue2) > 0 Or _
InStr(1, xValue1, xValue2 & delimiter) > 0) Then
Target.Value = xValue1 & delimiter & xValue2
Else
Target.Value = xValue1
End If
End If

Application.EnableEvents = True
On Error GoTo 0

End Sub

 

[BenExcel]

Bonjour,
Peut être comme cela:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
If IsEmpty(Target.Offset(0, -1)) Then
With Sheets("ID").Cells(1, 1)
Target.Offset(0, -1).Value = .Value
.Value = .Value + 1
End With
End If
End If

Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim delimiter As String
Dim TargetRange As Range

Set TargetRange = Me.UsedRange ' Users can change target range here
delimiter = ", " ' Users can change the delimiter here

If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
On Error Resume Next
Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False

xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" And xValue2 <> "" Then
If Not (xValue1 = xValue2 Or _
InStr(1, xValue1, delimiter & xValue2) > 0 Or _
InStr(1, xValue1, xValue2 & delimiter) > 0) Then
Target.Value = xValue1 & delimiter & xValue2
Else
Target.Value = xValue1
End If
End If

Application.EnableEvents = True
On Error GoTo 0

End Sub

Bonjour, oui cela fonctionne très bien!
Merci beaucoup, vous m'économisez un temps précieux!