Sub CopyPictures()
Dim ws As Worksheet, j As Long, shp
Set arrSh = ActiveWindow.SelectedSheets
For Each ws In ActiveWindow.SelectedSheets
For j = 1 To Worksheets("Лист1").Shapes.Count
Worksheets("Лист1").Shapes(j).Copy: ws.Select: ws.Paste
Selection.Top = Worksheets("Лист1").Shapes(j).Top
Selection.Left = Worksheets("Лист1").Shapes(j).Left
Next
Next
End Sub
отмечаете листы, жмете Alt+F8, находите и выполняете макрос выше
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!