Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
     Dim q&: q = Target.Row: If q < 1 Then Exit Sub
     With CreateObject("Outlook.Application")
         With .CreateItem(0)
             .To = "9228065000@mail.ru; 904873@mail.ru ; pasha_jerr.ru@mail.ru "
             .Subject = "Назначен монтаж на - " & Cells(q, 2) & " клиенту: " & Cells(q, 3)
             .Body = "Контрагент: " & Cells(q, 2) & vbCrLf & _
                     "Дата монтажа - " & Cells(q, 2) & " Город монтажа - " & Cells(q, 6) & vbCrLf & _
                     "Адрес монтажа - : " & Cells(q, 7) & vbCrLf & _
                     "Монтажные работы: 1. Монтаж точек -: " & Cells(q, 9) & "; 2. Монтаж сот-лайн - " & Cells(q, 10) & "; 3. Монтаж микротик - " & Cells(q, 11) & vbCrLf & _
             "Полная информация в отчете, в листе Общий график монтажей"
             .Display ' если нужно посмотреть письмо
             .Send
         End With
     End With
     Dim c&, r&, i&, n&, m$, s$, d(), v()
     c = Target.Column
     Select Case c
         Case 2, 3, 17
             r = Target.Row
             If r > 2 Then
                 r = r - 2
                 v = Cells(3, 2).Resize(Cells(Rows.Count, 17).End(xlUp).Row - 2, 16).Value
                 On Error Resume Next
                 s = v(r, 16)
                 With Worksheets(s)
                     n = v(r, 1)
                     d = .UsedRange.Columns(2).Value
                     For i = 1 To UBound(d)
                         If d(i, 1) = n Then
                             For r = r - 1 To 1 Step -1
                    If v(r, 1) <> n Then Exit For
                             Next
                             r = r + 1
                             For r = r To UBound(v)
                    If v(r, 1) <> n Then Exit For
                    If v(r, 16) = s Then m = m & ", " & v(r, 2)
                             Next
                             If Len(m) Then .Cells(i, 3) = Mid$(m, 3)
                             Exit For
                         End If
                     Next
                 End With
             End If
     End Select

End Sub