Probleme copier/coller suite utilisation macro calendrier

Bonjour,

J'utilise dans un tableau plusieurs macro. Une d'elles consiste à faire apparaitre et disparaitre un calendrier dans une cellule. La macro en elle même fonctionne très bien mais lorsque que je veux faire un copier/coller d'une donnée quelconque et bien le copier fonctionne mais impossible de coller la donnée.

Voici la totalité des macro utilisées:

MACRO CALENDRIER

Private Sub Calendar1_click()
    ActiveCell.Value = Calendar1.Value
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' si la sélection sur la feuille change (target est la référence de la sélection)
    If Target.Column <> 12 And Target.Column <> 13 And Target.Column <> Target.Row < 5 Or Target.Cells.Count > 1 Then
        'si la colonne <>3 (C) ou la ligne <2 ou la sélection fait plus d'1 cellule
        Calendar1.Visible = False
        'alors on cache le calendrier
        Exit Sub
    Else
        'sinon
        Calendar1.Top = Target.Offset(1, 0).Top + 2
        ' aligner le calendrier avec le haut de la cellule en dessous
        Calendar1.Left = Target.Left + 0
        ' l'aligner à gauche de la cellule
        'Calendar1.LinkedCell = Target.Address
        ' mettre la cellule liée au contrôle sur la cellule sélectionnée
        If IsDate(Target.Value) Then
        'si la cellule sélectionnée contient une date
            Calendar1.Value = Target.Value
            ' la récupérer
        Else
            ' sinon mettre la date du jour
            Calendar1.Value = Date
        End If
        Calendar1.Visible = True
        'afficher le calendrier
    End If
End Sub

MACRO CHANGEMENT DES COULEURS CELLULES

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range("B:z")) Is Nothing Then
Select Case Target.Value
Case Is = "Oui": Target.EntireRow.Range("b1:Z1").Interior.ColorIndex = 35: Target.EntireRow.Range("S1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
Case Is = "Non": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 15:
Case Is = "Favorable": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 35: Target.EntireRow.Range("s1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
Case Is = "Défavorable": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 15
Case Is = "Apte": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 35: Target.EntireRow.Range("s1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
Case Is = "Inapte": Target.EntireRow.Range("b1:z1").Interior.ColorIndex = 15
'Elimination des couleurs dans cellules vides
Case Is = "": Target.EntireRow.Range("b1:Q1").Interior.ColorIndex = 35: Target.EntireRow.Range("s1:w1").Interior.ColorIndex = 34: Target.EntireRow.Range("x1:z1").Interior.ColorIndex = 36
End Select
End If
End Sub

MACRO INSERTION COMMENTAIRE PAR BOUBLE CLICK CELLULE

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Application.Intersect(Target, Range("b:k,n:z")) Is Nothing Then
   With Target
     If .NoteText = "" Then
        reponse = InputBox("INDIQUEZ LE COMMENTAIRE")
        If reponse <> "" Then
            .AddComment reponse
            With .Comment.Shape.OLEFormat.Object.Font
              .Name = "ARIAL"
              .Size = 10
              .FontStyle = "gras"
              .ColorIndex = 1
            End With
            .Comment.Shape.Fill.ForeColor.RGB = RGB(255, 255, 0)
            .Comment.Visible = True
            .Comment.Shape.Select
            Selection.AutoSize = True
            .Comment.Visible = False
            Selection.HorizontalAlignment = xlCenter
            Selection.VerticalAlignment = xlCenter
            .Comment.Shape.Top = Target.Top + 3
            .Comment.Shape.Left = Target.Left + 35
            .Comment.Shape.Placement = xlMove
         End If
      Else
        .Comment.Delete
      End If
   End With
 End If
 Cancel = True
End Sub

Merci d'avance