Sub Мяу()
    Dim ar, i&, sh As Worksheet
    ar = Array("Таблица1", "Таблица13")
    On Error Resume Next
    For Each sh In ThisWorkbook.Worksheets
        For i = 0 To UBound(ar)
            With sh.ListObjects(ar(i))
                .ListRows(3).Range.Resize(.ListRows.Count - 2).Delete
            End With
        Next
    Next
End Sub

Sub qq()
    rowniz = Worksheets("Ëèñò1").Cells(Rows.Count, 4).End(xlUp).Row
    Cells(10, "F").Resize(rowniz - 9).FormulaR1C1 = "=RC[-2]*RC[-1]"
    Cells(rowniz + 1, "F").FormulaR1C1 = "=SUM(R10C6:R[-1]C)"
End Sub

Selection.Paste

(?:\s)\-([a-z0-9]+)(?=\s)

Sub qq()
    Dim x As Object
    Set x = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 243, 87.75, 116.25, 36)
    With x.DrawingObject
        .Interior.ColorIndex = 3
        .Caption = "УРЯ!"
        .Font.Size = 20
        .Font.Bold = True
        .ShapeRange.TextFrame.HorizontalAlignment = xlHAlignCenter
        .ShapeRange.TextFrame.VerticalAlignment = xlVAlignCenter
        .OnAction = "test"
    End With
End Sub
Sub test()
    MsgBox "УРА"
End Sub

   Prohlaseni = WorksheetFunction.VLookup(Reference, Workbooks("D:\BAZA.xlsx"). _
   Worksheets("DPG").Range("$D$5:$G$1000"), 4, 0)

Set objHTMLDoc = New HTMLDocument

ActiveSheet.UsedRange