Agregation de 2 codes ; Problème!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
[COLOR="DarkOrchid"]Dim c As Long, i As Long[/COLOR]
Cancel = True
With Target
    If .Column = 2 Then
        Cancel = True
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Shape.Width = 121.5
            .Comment.Shape.Height = 29.75
        End If
        SendKeys "%im"
    End If
    If Target.Column = 4 Then
Cells(Target.Row, 4) = Date
End If
End With
[COLOR="#9932cc"]If Intersect(Target, Union([klj], [infinite])) Is Nothing Then Exit Sub
    c = Target.Interior.ColorIndex
    For i = 1 To Range("couple").Count
        If Range("couple").Cells(i, 1).Interior.ColorIndex = c Then
            Target.Interior.ColorIndex = Range("couple").Cells(i + 1, 1).Interior.ColorIndex
            Target.Font.ColorIndex = Range("couple").Cells(i + 1, 1).Font.ColorIndex
            i = Range("couple").Count
            Cancel = True
             End If
    Next i[/COLOR]
End Sub