Sub copie_fusion()
Dim c As Range, p As Range, Selection As Range
Set firstCell = Range("C9")
Set lastCell = Range("C65536").End(xlUp)
Set Selection = Range(firstCell, lastCell)
'For Each c In Selection
'If c.MergeCells Then
'If c.Address = c.MergeArea.Cells(1, 1).Address Then
'Range(Cells(c.Row, 4), Cells(c.MergeArea(c.MergeArea.Count).Row, 4)) = c
'End If
'Else
'Range(Cells(c.Row, 4), Cells(c.Row, 4)) = c
'End If
'Next
For Each c In Selection
If c.MergeCells Then
If c.Address = c.MergeArea.Cells(1, 1).Address Then
Range(Replace(c.MergeArea.Address, "C", "D")) = c
End If
Else
Range(Replace(c.Address, "C", "D")) = c
End If
Next
End Sub