Sub Copy_Cell()
Dim Source As Range
Dim I As Single
Set Source = Worksheets("Feuil1").[B2]
Source.Copy
Worksheets("Feuil2").Select
With Range(Source.Address).MergeArea
.Select
.PasteSpecial Paste:=xlPasteAll
.PasteSpecial Paste:=xlPasteFormats
.Merge
.RowHeight = Source.RowHeight
I = 0.5: Do
.ColumnWidth = (Source.ColumnWidth / .Count) * I
I = I + 0.01
Loop Until .Width >= Source.Width
End With
End Sub