Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$7" Then Collecte
End Sub
Private Sub Collecte()
Dim Cel As Range, Déb As Date, Te(), Codes(), Périodes(), L As Long, J As Long 'Code As String
With ThisWorkbook.Worksheets(1)
Déb = .[C8].Value - 1
Set Cel = .[A9:A505].Find(What:=Me.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder _
:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False): End With
If Cel Is Nothing Then MsgBox Feuil106.[C7].Value & " inexistant": Exit Sub
Te = Cel.Offset(, 2).Resize(, 32).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0
If Te(1, 1) <> "" Then L = 1: Codes(L, 1) = Te(1, 1): Périodes(1, 1) = Déb + 1
For J = 2 To 32
If Te(1, J) <> Te(1, J - 1) Then
If Te(1, J - 1) <> "" Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
If Te(1, J) <> "" Then L = L + 1: Codes(L, 1) = Te(1, J): Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
End If
Next J
Me.[A13].Resize(19, 1).Value = Codes
Me.[C13].Resize(19, 2).Value = Périodes
End Sub