Sub COPY1()
 Sheets("Лист4").Range("G2").Select
    Selection.Copy
    Worksheets("Лист2").Range("A2").PasteSpecial Paste:=xlPasteValues
End Sub

Sub НазначениеОдногоМакросаВсемФигурам()
    Dim Sh As Worksheet, sha As Shape
    For Each Sh In ActiveWorkbook.Worksheets    ' перебираем все листы в активной книге
        For Each sha In Sh.Shapes    ' перебираем все фигуры на очередном листе
            ' назначаем макрос только тем фигурам, которым ещё не назначены макросы
            If sha.OnAction = "" Then sha.OnAction = "МакросДляФигуры"
        Next sha
    Next Sh
End Sub

Sub МакросДляФигуры()
On Error Resume Next
' получаем ссылку на фигуру, с которой был вызван этот макрос
Dim sha As Shape: Set sha = ActiveSheet.Shapes(Application.Caller)
 
' заносим в диапазон ячеек a2:f2 координаты и размеры выделенной фигуры
Range("a2:f2").Value = Array(sha.Left, sha.Top, _
sha.Left + sha.Width, sha.Top + sha.Height, _
sha.Width, sha.Height)
 
sha.Select ' выделяем фигуру, которая запустила макрос
End Sub

Sub OVAL()
ActiveSheet.Shapes.Range(Array("Овал 1")).IncrementLeft 975
DoEvents
Application.Wait (Now + TimeSerial(0, 0, Sheets("Лист2").Range("A2").Value))
End Sub

Private Sub
CommandButton1_Click()

Dim
objWrdApp As Object, objWrdDoc As Object

    Set AppWord =
CreateObject("Word.Application")
    Set objWrdDoc = AppWord.Documents.Add
   
Sheets("1").Range("A1:С4").Copy
    objWrdDoc.Range(0).Paste
    objWrdDoc.SaveAs
"C:\Users\nerf\Desktop\мое\1.docx"

    Application.CutCopyMode = False
    AppWord.Quit 0

    Set AppWord = Nothing
    Application.DisplayAlerts = False
  Application.Quit
End Sub

Private Sub CommandButton1_Click()
Dim objWrdApp As Object, objWrdDoc As Object
    Set AppWord = CreateObject("Word.Application")
    Set objWrdDoc = AppWord.Documents.Add
    Sheets("8").Range("A1:" & Sheets("8").Range("V1").Value).Copy
    objWrdDoc.Range(0).Paste
    objWrdDoc.SaveAs Sheets("8").Range("W1").Value & ".docx"
    Application.CutCopyMode = False
    AppWord.Quit 0
    Set AppWord = Nothing
    Application.DisplayAlerts = False
  Application.Quit
End Sub

Private Sub Worksheet_Calculate()
    Dim dVal As Integer
    dVal = Sheets("1").Range("B1").Value
    If dVal = 1 Then
            With ActiveSheet
                .Shapes.Item(1).Visible = True
                .Shapes.Item(2).Visible = False
            End With
    ElseIf dVal = 2 Then
         With ActiveSheet
                .Shapes.Item(1).Visible = False
                .Shapes.Item(2).Visible = True
        End With
    End If
End Sub