Planning vendeurs pdv

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells(1, 1).MergeArea.Count <> 3 Then Exit Sub
Dim F As Worksheet, H As Byte, L As Byte, lig1 As Variant, cel As Range, lig2 As Long
Cancel = True
Set F = Sheets("PL VENDEURS")
H = Application.CountA(F.Rows(1))
L = Cells(Target.Row + 2, 2).End(xlToRight).Column - 1
Cells(Target.Row + 3, 2).Resize(H, L).Interior.ColorIndex = xlNone
lig1 = Application.Match(Target.Cells(1, 1), F.Columns(2), 0)
If IsError(lig1) Then Exit Sub
lig2 = Target.Row + 2
For Each cel In F.Rows(1).SpecialCells(xlCellTypeConstants)
  If cel <> "" Then
    lig2 = lig2 + 1 'ligne à colorer
    Colore lig2, F.Cells(lig1, cel.Column).Text
    Colore lig2, F.Cells(lig1, cel.Column + 1).Text
  End If
Next
End Sub

Sub Colore(lig As Long, txt As String)
Dim n1 As Byte, n2 As Byte, plage As Range
If txt = "" Then Exit Sub
txt = Replace(Replace(txt, "h", ""), " ", "")
n1 = CInt(Split(txt, "a")(0)): n2 = CInt(Split(txt, "a")(1))
Set plage = Range(Cells(lig, n1 - 7), Cells(lig, n2 - 8))
plage.Interior.ColorIndex = 6 'couleur jaune
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [Liste].EntireRow) Is Nothing Then [Date] = [Date] 'crée l'évènement Change
End Sub