Peux plus faire Ctrl C - Ctrl V !!!!

Bonjour,

J'ai cette macro qui me permet d'avoir des reperes dans un tableau, le
probleme c'est que je ne peux plus faire de Copier / Coller
Quelqu'un a t il une idée
Merci d'avance
BS

---------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
' Site web : www.polykromy.com
' Copyright Gaetan Mourmant

Dim h&, w2&, t&, w&, Shp As Shape
With ActiveCell
h = .Height
w2 = .Width
t = .Top
w = .Left
End With
With ActiveSheet
'Teste si les rectangles existent déjà.
On Error Resume Next
.Shapes("RectangleV").Delete
.Shapes("RectangleH").Delete
.Shapes("RectangleX").Delete
On Error GoTo 0
'Ajoute les rectangles
Set Shp = .Shapes.AddShape(msoShapeRectangle, 0, t, w, h)
With Shp
.Name = "RectangleV"
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 1#
.Line.ForeColor.SchemeColor = 10
.ControlFormat.PrintObject = False
End With
Set Shp = .Shapes.AddShape(msoShapeRectangle, w, 0, w2, t)
With Shp
.Name = "RectangleH"
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 1#
.Line.ForeColor.SchemeColor = 10
.ControlFormat.PrintObject = False
End With
Set Shp = .Shapes.AddShape(msoShapeRoundedRectangle, w, t, w2, h)
With Shp
.Name = "RectangleX"
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 1.5
.Line.ForeColor.SchemeColor = 4
.ControlFormat.PrintObject = False
End With

End With
Set Shp = Nothing
End Sub