Sub Test() Dim s1 As Shape, s2 As Shape Set s1 = ActiveShape Set s2 = ActiveLayer.CreateEllipse2(4, 5, 3) s2.ObjectData.CopyFrom s1End Sub