=СУММ(СУММЕСЛИМН($E$7:$E$19;$D$7:$D$19;{"Выполнено";"Доставка"}))

=СУММ(СУММЕСЛИМН($E$7:$E$19;$D$7:$D$19;H15))

=ЕСЛИ(D2<>"";СЧЁТЕСЛИМН(Лист1!F2:F6;D2;Лист1!H2:H6;"*"&A2&"*");СЧЁТЕСЛИ(Лист1!H2:H6;"*"&A2&"*"))

=ЕСЛИ(СЧЁТЕСЛИ(Лист1!G2:G21,Лист1!A2)>0,СЧЁТЕСЛИ(Лист1!G2:G21,Лист1!A2),"")

Sub script()
Dim i As Integer
Dim Name5 As String

i = 5
Name = "Текст"

MsgBox Name5
End Sub

Dim i As Long
  With ListBox1          'имя списка
    For i = 0 To .ListCount
      If .Selected(i) Then
        Sheets("Лист1").Rows(i + 1 & ":" & i + 1).Clear
      End If
    Next
  End With

Sub DeleteEmptyRows()
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
End Sub

Sub Кнопка1_Щелчок()

With Range("I5").Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 0
    .Gradient.ColorStops.Clear
End With
With Range("I5").Interior.Gradient.ColorStops.Add(0)
    .Color = RGB(191, 191, 191)
    .TintAndShade = 0
End With
With Range("I5").Interior.Gradient.ColorStops.Add(1)
    .Color = RGB(146, 208, 80)
    .TintAndShade = 0
End With

End Sub

Sub Кнопка2_Щелчок()

If Range("I5").Interior.Gradient.ColorStops.Add(0).Color = RGB(191, 191, 191) Then
MsgBox "Соответствует"
Else
MsgBox "Не соответствует"
End If

End Sub

Private Sub CommandButton1_Click()

For i = 1 To 3 Step 1

UserForm1.Image1.Visible = False

Next i

End Sub

CommandButton1.Picture = LoadPicture("F:\picture.jpg")

=СЧЁТЕСЛИМН(Лист2!F6:F26;Лист1!H6;Лист2!E6:E26;">=07.01.2017";Лист2!E6:E26;"<=15.01.2017")

Private Sub CommandButton1_Click()
Dim i As Integer

For i = 1 To 10 Step 1
    Range("B" & i).Value = i
    CommandButton1.Enabled = False
    Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
' Цвета http://www.endprod.com/colors/
'
' Оранжевый: 2200045, Красный: 5245579, Зелёный: 2263842, Чёрный: 0, Жёлтый: 9434879
     
     If Range("H3").Value = 1 Then
        CommandButton3.Caption = "1"
     ElseIf Range("H3").Value = 2 Then
        CommandButton3.Caption = "2"
     ElseIf Range("H3").Value = 3 Then
        CommandButton3.Caption = "3"
     ElseIf Range("H3").Value = 4 Then
        CommandButton3.Caption = "4"
     ElseIf Range("H3").Value = 5 Then
        CommandButton3.Caption = "5"
     Else: CommandButton1.Caption = "000"
     End If
     
     If Range("H5").Value = 1 Then
        CommandButton1.Caption = "1"
     ElseIf Range("H5").Value = 2 Then
        CommandButton1.Caption = "2"
     ElseIf Range("H5").Value = 3 Then
        CommandButton1.Caption = "3"
     ElseIf Range("H5").Value = 4 Then
        CommandButton1.Caption = "4"
     ElseIf Range("H5").Value = 5 Then
        CommandButton1.Caption = "5"
     Else: CommandButton1.Caption = "000"
        CommandButton1.ForeColor = 0
     End If
     
End Sub

Private Sub CommandButton1_Click()
    Worksheets("Задачник").Range("A10:K10").Copy
    
On Error Resume Next
Err.Clear
Range("D2:D21").SpecialCells(xlCellTypeBlanks).Cells(1, -2) = "Сюда вставляем текст"
If Err <> 0 Then MsgBox "Всё заполнено!!!"
Err.Clear
End Sub

Sub Macros()

iText = "ИСТИНА"

If CStr(Range("F15")) = iText Then
       Range("F19").FormulaR1C1 = "AAA"
       Else
End If

If CStr(Range("G15")) = iText Then
       Range("G19").FormulaR1C1 = "BBB"
       Else
End If

If CStr(Range("H15")) = iText Then
       Range("H19").FormulaR1C1 = "CCC"
       Else
End If

If CStr(Range("I15")) = iText Then
       Range("I19").FormulaR1C1 = "DDD"
       Else
End If

End Sub

Sub Macros2()

iText = "1"

If CStr(Range("K15")) = iText Then
       Range("K19").FormulaR1C1 = "AAA"
       Else
End If

If CStr(Range("L15")) = iText Then
       Range("L19").FormulaR1C1 = "BBB"
       Else
End If

If CStr(Range("M15")) = iText Then
       Range("M19").FormulaR1C1 = "CCC"
       Else
End If

If CStr(Range("N15")) = iText Then
       Range("N19").FormulaR1C1 = "DDD"
       Else
End If

End Sub

Private Sub CommandButton1_Click()Dim objWrdApp As Object
Dim objWrdDoc As Object
On Error Resume Next
Set objWrdApp = GetObject(, "Word.Application")
        If Err Then
            Err.Clear
            Set objWrdApp = CreateObject("Word.Application")
            If Err Then MsgBox "Нету Ворда на машине!": Exit Sub
        End If
objWrdApp.Visible = True
Set objWrdDoc = objWrdApp.Documents.Open("C:\DOCUMENTS\1.doc")
End Sub

Sub Geometry()
 Dim arr As Variant
 With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With
 Set oWord = CreateObject("Word.Application")
 oWord.Visible = True
 Set oDoc = oWord.Documents.Open(ThisWorkbook.Path & "\" & "Файл.doc)
   
rr = 1
  
'On Error Resume Next
For aTbl = 1 To 4   'oDoc.tables.Count
ReDim arr(1 To oDoc.tables(aTbl).Rows.Count, 1 To oDoc.tables(aTbl).Columns.Count)
    For j = 1 To UBound(arr, 2)
        For i = 1 To UBound(arr, 1)
            arr(i, j) = Trim(Replace(oDoc.tables(aTbl).cell(i, j).Range.Text, Chr(7), ""))
    If IsNumeric(arr(i, j)) Then arr(i, j) = --arr(i, j)
        Next i
    Next j
ThisWorkbook.Sheets("Geo").Range("A" & rr).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
rr = rr + oDoc.tables(aTbl).Rows.Count + 2
arr = Empty
Next
 
oWord.Quit False
'..................
With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With
MsgBox "Геометрия загружена"
  End Sub

Private Sub CommandButton1_Click()
    Range("C4").FormulaR1C1 = "=RC[-2]"
    Range("C5").FormulaR1C1 = "=RC[-2]"
    Range("C6").FormulaR1C1 = "=RC[-2]"
End Sub

Sub Zapusk()

    Call Макрос1
 
 Dim strFilPath As String, strFilNM As String
 
 strFilPath = "F:\"
 strFileName = "F:\111.txt"
 strFilNM = Dir(strFileName)
If strFilNM <> "" Then
    Call Макрос2
    
 strFilPath = "F:\"
 strFileName = "F:\222.txt"
 strFilNM = Dir(strFileName)
ElseIf strFilNM <> "" Then
    Call Макрос3
    
 strFilPath = "F:\"
 strFileName = "F:\333.txt"
 strFilNM = Dir(strFileName)
ElseIf strFilNM <> "" Then
    Call Макрос4
   
   End If

End Sub

Private Sub CommandButton4_Click()

Call Макрос_1
Call Макрос_2
Call Макрос_3

End Sub

Sub SheetsCopy()
  With Workbooks.Open("http://www.planetaexcel.ru/bitrix/components/bitrix/forum.interface/show_file.php?fid=252887&action=download", ReadOnly:=True)
    .Sheets.Copy Before:=ThisWorkbook.Sheets(1)
    .Close False
  End With
End Sub

Sub SheetsCopy()
  With Workbooks.Open("http://www.planetaexcel.ru/bitrix/components/bitrix/forum.interface/show_file.php?fid=252887&action=download", ReadOnly:=True)
    .Sheets.Copy Before:=ThisWorkbook.Sheets(1)
    .Close False
  End With
End Sub

Sub Макрос2()
'
' Макрос2 Макрос
' Подбор высоты
'
    Range("B30:AO36").Select

End Sub