Worksheet_Change extraction et gestion des doublons

 Option Explicit
Dim Continuer1 As Integer, Continuer2 As Integer
Dim MaLigne As Long
Dim FL1 As Worksheet, FL2 As Worksheet, FL3 As Worksheet
Dim SHT1 As String, SHT2 As String, SHT3 As String
Dim TBL1 As String, TBL2 As String
Dim ValCell As Variant
Dim cell As Range, trouveC1 As Range, trouveC2 As Range, trouveL As Range
Dim PlageR1 As Range, PlageR2 As Range, PlageR3 As Range
Dim Vcc1 As String, Vcc2 As String, Vcc3 As String
Dim At1 As String, At2 As String, At3 As String
Dim DerL%, DerL2%
Dim i As Integer

Private Sub Worksheet_Change(ByVal Target As Range)

SHT1 = "Data"
SHT2 = "Planning"
SHT3 = "Convocations"
TBL1 = "A1"
TBL2 = "B5"

Set FL1 = Worksheets(SHT1)
Set FL2 = Worksheets(SHT2)
Set FL3 = Worksheets(SHT3)

DerL = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
DerL2 = Worksheets("convocations").Cells(Rows.Count, 2).End(xlUp).Row
FL1.Columns(12).NumberFormat = "dd/mm/yy;@"
FL2.Range(TBL2).CurrentRegion.Offset(1, 1).NumberFormat = "dd/mm/yy;@"

If Target.Count > 1 Then
Exit Sub
End If

' On active la macro si une cellule est modifiée
If Not Application.Intersect(Target, Range("L2:L" & DerL)) Is Nothing _
Or Not Application.Intersect(Target, Range("M2:M" & DerL)) Is Nothing _
Or Not Application.Intersect(Target, Range("N2:N" & DerL)) Is Nothing Then
Continuer1 = MsgBox("Êtes-vous certain de vouloir convoquer à cette date/heure?", vbYesNo + vbExclamation + vbDefaultButton2)
Application.EnableEvents = False
Target.NumberFormat = "dd/mm/yy;@"
Application.EnableEvents = True
Else
Exit Sub
End If

Application.EnableEvents = False
With FL3
' calcul de la première ligne vide sur les 4 colonnes
MaLigne = .UsedRange.Resize(, 15).Find("*", , , , xlRows, xlPrevious).Row + 1
  ' si on ne continue pas
  If Continuer1 = vbNo Then
  Target.Value = ValCell
  ' si on continue
  Else
   
'On vérifie s'il y a bien une convocation à envoyer
  If Cells(Target.Row, 6).Value = "" And _
  Cells(Target.Row, 7).Value = "" And _
  Cells(Target.Row, 8).Value = "" And _
  Cells(Target.Row, 9).Value = "" And _
  Cells(Target.Row, 10).Value = "" Then
  MsgBox ("il n'y a pas de convocation à envoyer pour l'opération " & Cells(Target.Row, 2).Value & " de l'équipement " & Cells(Target.Row, 12).Value)
  Target.Value = ValCell
  Else
  
  'on cherche les dates de début d'opération du planning par équipement
  'affectation de valeurs aux variables :
  Vcc1 = FL1.Cells(Target.Row, 2).Value
  Vcc2 = "debut"
  Vcc3 = FL1.Cells(Target.Row, 11).Value

  'On définit les différentes plages de recherches
  Set PlageR1 = FL2.Rows(4)
  Set PlageR2 = FL2.Rows(5)
  Set PlageR3 = FL2.Columns(2)
  
  '*******************************

  'On cherche la valeur exacte (LookAt:=xlWhole) 
  Set trouveC1 = PlageR1.Cells.Find(what:=Vcc1, LookAt:=xlWhole)
  If Not trouveC1 Is Nothing Then
  Set trouveC2 = PlageR2.Cells.Find(what:=Vcc2, LookAt:=xlWhole)
  If Not trouveC2 Is Nothing Then
  Set trouveL = PlageR3.Cells.Find(what:=Vcc3, LookAt:=xlWhole)
  If Not trouveL Is Nothing Then
  
  'On enregistre les valeurs
  At1 = trouveC1.Address
  At2 = trouveC2.Address
  At3 = trouveL.Address
  
  End If
  End If
  End If
  
  'On compare avec la date saisie avec la date du planning
  If Target <> FL2.Cells(Range(At3).Row, Range(At1).Column).Value Then
  Continuer2 = MsgBox("Vous allez convoquer à une date différente du début d'opération" & "(" & FL2.Cells(Range(At3).Row, Range(At1).Column).Value & ")", vbYesNo + vbExclamation + vbDefaultButton2)
  If Continuer2 = vbNo Then
  Target.Value = ValCell
  Else
  
  For i = 29 To DerL2
  If Not Sheets("Convocations").Cells(i, 2).Cells.Find(what:=Cells(Target.Row, 1).Value, LookAt:=xlWhole) Is Nothing _
  And Not Sheets("Convocations").Cells(i, 3).Cells.Find(what:=Cells(Target.Row, 11).Value, LookAt:=xlWhole) Is Nothing _
  And Not Sheets("Convocations").Cells(i, 4).Cells.Find(what:=Cells(Target.Row, 2).Value, LookAt:=xlWhole) Is Nothing Then
  Sheets("Convocations").Cells(i, 4).EntireRow.Delete
  End If
  Next
  
  ' on injecte les 15 valeurs directement en passant un tableau
  Worksheets("convocations").Cells(MaLigne, 1).Resize(1, 15).Value = _
  Array("", Cells(Target.Row, 1).Value, _
  Cells(Target.Row, 11).Value,  Cells(Target.Row, 2).Value, Cells(Target.Row, 4).Value, "", _
  Cells(Target.Row, 5).Value, Cells(Target.Row, 8).Value,  Cells(Target.Row, 9).Value, _
  Cells(Target.Row, 10).Value, Cells(Target.Row, 12).Value, Cells(Target.Row, 13).Value, _
  Cells(Target.Row, 14).Value, Cells(Target.Row, 15).Value,  Cells(Target.Row, 16).Value)
  
  End If
  End If
  End If
  End If
  
Set PlageR1 = Nothing
Set PlageR2 = Nothing
Set PlageR3 = Nothing
Set trouveC1 = Nothing
Set trouveC2 = Nothing
Set trouveL = Nothing
Application.EnableEvents = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
DerL = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
If Not Application.Intersect(Target, Range("L2:L" & DerL)) Is Nothing _
Or Not Application.Intersect(Target, Range("M2:M" & DerL)) Is Nothing _
Or Not Application.Intersect(Target, Range("N2:N" & DerL)) Is Nothing Then
ValCell = Target
End If
End Sub