XL 2016 Comment fusionner 2 Private Sub Worksheet_Change(ByVal Target As Range) ?

[Kmi]

Bonjour,

Je suis en train de concevoir une mini application sous excel afin de pouvoir suivre les processus de recrutement. Toutefois, je ne parviens pas à faire fonctionner 2 macros en worksheet change. J'ai parcouru de nombreux sujets afin de résoudre mon problème sans succès.

Mon but est de faire apparaître 5 listes déroulantes à choix multiples (1ère macro qui intervient dans les colonnes I, J, K,L,M) et de déplacer les lignes de la feuille "CANDIDAT" vers la feuille "PLANIFIER ENTRETIEN" (2e macro qui intervient dans la colonne P). Je souhaite faire fonctionner ces deux macros dans la même feuille.

Voici mes deux macros séparées (feuille "CANDIDAT"):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 12 Or Target.Column = 13 Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

ElseIf If Target.Count > 1 Then Exit Sub
If Target.Column <> 12 Then Exit Sub
If Target <> "" Then
Lig = Sheet6.[A65000].End(3).Row + 1
lg = Target.Row
Sheet6.Range("D" & Lig & ":P" & Lig).Value = Range("D" & lg & ":P" & lg).Value
Application.EnableEvents = False
Rows(lg).Delete
Application.EnableEvents = True
End If
End Sub

Pourriez-vous me guider afin de parvenir à concrétiser ceci s'il-vous-plait ? Je vous remercie de l'aide que vous pourrez m'apporter.

 

[CHALET53]

Bonjour,
Peut-être avec Select Case (je n'ai pas touché au programme : seul ajout Select Case Instructions en gras)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True

Select Case Target.Column
Case Is <= 13
On Error GoTo Exitsub
If Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 12 Or Target.Column = 13 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
Case Else
If Target.Column <> 12 Then Exit Sub
If Target <> "" Then
Lig = Sheet6.[A65000].End(3).Row + 1
lg = Target.Row
Sheet6.Range("D" & Lig & "" & Lig).Value = Range("D" & lg & "" & lg).Value
Application.EnableEvents = False
Rows(lg).Delete
Application.EnableEvents = True
End If
End Select
End Sub

 

[Hasco]

Bonjour,

Une proposition avec un peu de remaniement de la macro, ainsi que l'utilisation de ListObject (tableau structuré).

Cordialement

 

[Kmi]

Je vous remercie pour votre aide.