bonjour, 15 cases :
Sub make_Shapes()
Dim MesColonnes: MesColonnes = Array("D", "F", "H", "J", "L")
With ActiveSheet
.Shapes.SelectAll
Selection.Delete
Set shp = .Shapes.AddShape(msoShapeRectangle, 50, 50, 100, 200)
For i = 63 To 70 Step 3
For Each col In MesColonnes
Set c = .Cells(i, col)
shp.Copy
.Paste
Wachten 'Application.Wait Now + TimeSerial(0, 0, 1)
With .Shapes(.Shapes.Count)
.Left = c.Left
.Top = c.Top
.Width = Application.Max(c.Offset(, 1).Left - c.Left - 0, 1)
.Height = Application.Max(c.Offset(1).Top - c.Top - 0, 1)
.Placement = xlMoveAndSize
.Fill.ForeColor.RGB = RGB(WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255))
.TextFrame2.TextRange.Characters.Text = "mon bouton " & c.Address
.OnAction = "Bonjour"
End With
Next
Next
End With
End Sub