Sub Création_Test()
Dim i&, shp As Shape
Application.ScreenUpdating = False
[A1:E5] = "=ADDRESS(ROW(),COLUMN(),4)": [A1:E5] = [A1:E5].Value: [A1].CurrentRegion.Columns.AutoFit
For i = 1 To 3
Cells(1).CurrentRegion.Font.Color = Choose(i, vbWhite, vbYellow, vbYellow)
Cells(1).CurrentRegion.Interior.Color = RGB(i * 84, 0, i * 12)
Cells(1).CurrentRegion.Copy
Range("D2").Offset(i * 5, i * 2).Select
ActiveSheet.Pictures.Paste
Next
Set shp = ActiveSheet.Shapes.AddShape(17, 312, 34.5, 177, 169.5): [C3].Select
End Sub