Sub CopieCellule()
Dim celtest As Range, source As Range, dest As Range
Dim s As Shape, i As Byte
'---définitions à adapter---
Set celtest = Sheets("Donnée VH").[A27]
Set source = Sheets("Inters").[R3]
Set dest = Sheets("Inters").[G3].MergeArea
If celtest <> "" Then
'---RAZ---
For Each s In dest.Parent.Shapes
If s.TopLeftCell.MergeArea.Address = dest.Address Then s.Delete
Next
'---copie---
dest.UnMerge 'en cas de cellule fusionnée
source.Copy dest(1)
dest.Merge
'---bordures du contour---
For i = 7 To 10
dest.Borders(i).LineStyle = xlDouble
dest.Borders(i).Color = vbRed
Next
End If
End Sub