Bonjour François et à tous,
J'ai crié victoire trop tôt.
A+
Bonne journée
Voici mon module actuel:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne
Dim NbInr As Integer, NbLigne As Long
Dim Cel As Range
If Target.Count > 1 Then Exit Sub
InitTOTO
If Not Intersect(Range("C3:C" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
If UCase(Target) <> "TOTO" Then
Range("A" & Target.Row & ":C102").ClearContents
Ligne = Range("E" & Rows.Count).End(xlUp).Row
Range("E" & Ligne & ",G" & Ligne & ":H" & Ligne) = ""
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("E" & Rows.Count).End(xlUp).Offset(1, 0) = NbGoutte
Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = Range("A" & Target.Row)
Target = "TOTO"
Range("B" & Target.Row + 1 & ":C102").ClearContents
NbInr = Application.CountIf(Range("C3:C102"), "TOTO")
If NbInr = 1 Then
Ligne = Target.Row
If Ligne > 3 Then
Range("A3:C" & Ligne - 1).Delete shift:=xlShiftUp
End If
Range("A3:C3").AutoFill Destination:=Range("A3:C102"), Type:=xlFillSeries
Range("B4:C102").ClearContents
ElseIf NbInr = 5 Then
For Ligne = 4 To Target.Row
If UCase(Range("C" & Ligne)) = "TOTO" Then
Range("A3:C" & Ligne - 1).Delete shift:=xlShiftUp
Exit For
End If
Next Ligne
Ligne = Target.Row
Range("A" & Ligne & ":C" & Ligne).AutoFill Destination:=Range("A" & Ligne & ":C102"), Type:=xlFillSeries
Range("B" & Ligne + 1 & ":C102").ClearContents
End If
ElseIf Not Intersect(Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
Application.EnableEvents = False
NbLigne = 103 - Target.Row
If NbLigne > 1 Then Range("B" & Target.Row).AutoFill Destination:=Range("B" & Target.Row).Resize(Application.Min(NbJour, NbLigne))
If Target = NbGoutte And Target.Offset(0, 1) = "TOTO" Then
Range("H" & Rows.Count).End(xlUp).Offset(1, 0) = DateAdd("d", NbJour - 1, Range("A" & Target.Row))
End If
End If
Init_Feuilles
Application.EnableEvents = True
End Sub