je ne suis pas sur d'avoir bien compris ta demande mais tu peux tester la procedure ci dessous
Sub ShapesParFeuille()
Dim i As Byte
For i = 1 To Sheets.Count
With Sheets(i).Shapes.AddShape(msoShapeRectangle, 40, 40, 50, 50)
.Name = Sheets(i).Name
.TextFrame.Characters.Text = Sheets(i).Name
End With
Next i
End Sub