Application.DisplayAlerts = False
Application.DisplayAlerts = 1

Sub srav()
Dim a()
Dim b()
Dim i As Long
a = Range("a1:a6").Value
b = Range("b1:b6").Value
For i = 2 To 6
If a(i, 1) < b(i, 1) Then a(i, 1) = 1
Next
End Sub

Sub pr()
[e4].Select
[e4] = 1
[e4].AutoFill Destination:=Range([e4], Range(Selection, Selection.End(xlDown))), Type:=xlFillSeries
End Sub

Sub добавить()
Application.ScreenUpdating = False
'как сделать чтобы указанное ко-во ячеек заполнялось, а не только одна.
'r-ко-во ячеек для заполнения ActiveCell.Value = "Первый"
r = 3
'этот код работает на одну ячейку
ActiveCell.Value = "Первый"
ActiveCell.Cells(1, 2).Activate
Application.ScreenUpdating = True
End Sub

Sub zapusk()
Static objWrdApp As Object
Dim objwrddoc As Object
On Error Resume Next
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
Set objWrdApp = GetObject(, "Word.Application")
Set objwrddoc = objWrdApp.documents.Open("\\aaaa\111.docx")
objWrdApp.Visible = True
End If
Set objwrddoc = objWrdApp.documents.Open("\\aaaa\111.docx")
Set objWrdApp = Nothing
Set objwrddoc = Nothing
End Sub

Sub удалить ()
Application.ScreenUpdating = False
Sheets("Книга").Select
Dim FindRng As Range, TxtFind As String, FirstAdr As String
TxtFind = Application.InputBox("нумерВведи")
Set FindRng = Columns(1).Find(What:=TxtFind, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not FindRng Is Nothing Then
FirstAdr = FindRng.Address
Do
Range(Cells(FindRng.Row, 5), Cells(FindRng.Row + 3, 8)).Value = ""
Cells(FindRng.Row + 1, 6) = "в"

'Set FindRng = Cells.FindNext(FindRng)

Loop While FindRng.Address <> FirstAdr
Else
'        MsgBox "Значение " & TxtFind & " не найдено!", 48, "Ошибка!"

End If
Sheets("кни").Select
Application.ScreenUpdating = True
End Sub

Application.DisplayAlerts = False
    ActiveWorkbook.UpdateLink Name:= _
        "\\aaaa\Книга.xlsm", Type:= _
        xlExcelLinks
Application.DisplayAlerts = True

Sub Скопи()
Dim y As Range
'
    If WorkBookIsOpen("Книга1.xlsm") Then
Workbooks("Книга1.xlsm").Activate
   Sheets(1).Select
Else
Workbooks.Open ("\\aaaa\Книга1.xlsm")
   Sheets(1).Select
End If
ActiveWindow.ActivatePrevious
    Range("BE15").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveWindow.ActivateNext
    Set y = Application.InputBox("Выберите ячейку", , , , , , , 8)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Private Sub ComboBox1_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyEscape Then
Unload UserForm1
End If