试试这个代码
Sub Macro1()
Dim i As Integer
Dim t As Worksheet
Dim myshape As Shape
Set t = ActiveSheet
t.Shapes(1).Select
Selection.Copy
For i = 2 To 4
Cells(i, 6).Select
ActiveSheet.Paste
Set myshape = t.Shapes(i)
myshape.Select
Selection.Characters.Text = Cells(i, 1)
Next i
End Sub