Private Sub Worksheet_Change(ByVal rg As Range)
  Dim Nv, Ov, Lv
  If Intersect(rg, Range("O:O", "S:T")) Is Nothing Or rg.Count > 1 Then Exit Sub
  If Len(rg) = 0 Then Exit Sub
  Application.EnableEvents = False:  Nv = rg:  Application.Undo:  Ov = rg
  If Ov = Nv Then rg = "": Application.EnableEvents = True: Exit Sub
  If Len(Ov) = 0 Then
    rg = Nv
  Else
    Lv = NvInOv(CStr(Nv), Ov): If Lv = False Then rg = rg & ";" & Nv Else rg = Lv
  End If
  Application.EnableEvents = True
End Sub
 
 
Function NvInOv(Nv$, Ov)
  Dim v, i&
  v = Split(Ov, ";"): NvInOv = False
  For i = LBound(v) To UBound(v)
    If v(i) = Nv Then
      v(i) = Empty: NvInOv = Replace(Join(v, ";"), ";;", ";"): v = Split(NvInOv, ";")
      If v(UBound(v)) = "" Then NvInOv = Left(NvInOv, Len(NvInOv) - 1)
      If Left(NvInOv, 1) = ";" Then NvInOv = Right(NvInOv, Len(NvInOv) - 1)
      Exit Function
    End If
  Next
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myRange As Range
    Set myRange = Worksheets("Заявка на подключение").Range("A:O")

    If Application.Intersect(Target, myRange) Is Nothing Then
    Application.CellDragAndDrop = False
  
    Else
     Application.CellDragAndDrop = True
  
 End If

 End Sub
 
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Intersect(Target, Range("M:T")) Is Nothing Then Cancel = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("C15:C18")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target = Target & ";" & newVal
        Else
            Target = newVal
        End If
        If Len(newVal) = 0 Then Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub

Sub Кнопка2_Щелчок()
Dim cCell As Range
For Each cCell In ActiveWindow.RangeSelection
Application.CutCopyMode = False
Selection.Hyperlinks.Delete
Selection.NumberFormat = "General"
Selection.Value = Selection.Value
    
Next

End Sub

=ЕСЛИ(ПОИСК(F2;B:B;0);"+";0)

Sub terr()
Dim poslrow As Long, poslrow2 As Long

poslrow = Sheets("Закрыто").Cells(Rows.Count, 1).End(xlUp).Row
poslrow2 = Sheets("exportSD (КАСПП)").Cells(Rows.Count, 14).End(xlUp).Row

For i = 2 To poslrow2
  If Sheets("exportSD (КАСПП)").Cells(i, 14) = Sheets("Закрыто").Columns(1).Find(iVal, , xlFormulas, xlWhole) Then
     
     Sheets("exportSD (КАСПП)").Cells(i, 36) = Sheets("Закрыто").Cells(i, 12)
End If
Next i
End Sub

Sub dat()
Dim poslrow As Long, poslrow2 As Long

poslrow = Sheets("Поступило за день").Cells(Rows.Count, 9).End(xlUp).Row
poslrow2 = Sheets("Поступило за день").Cells(Rows.Count, 5).End(xlUp).Row

x = Date

For i = 2 To poslrow
    If x = Sheets("Поступило за день").Cells(i, 9).End(xlUp).Row Then
        If Sheets("Поступило за день").Cells(i, 5).End(xlUp).Row = "Закрыто" Then
            Sheets("Поступило за день").Rows(i, Sheets("Поступило за день").Cells(i, Columns.Count).End(xlToLeft).Column).Interior.Color = RGB(235, 241, 222)
        End If
    End If

Exit For
Next i

End Sub

Sub macro()
Dim poslrow  As Long, poslcol As Long

poslrow = Sheets("1").Cells(Rows.Count, 3).End(xlUp).Row
poslcol = Sheets("1").Cells(7, Columns.Count).End(xlToLeft).Column

    For i = 7 To poslrow
        If Sheets("1").Cells(i + 1, 5) <> "" Then
            If Sheets("1").Cells(i, 6) <> (Sheets("1").Cells(i + 1, 6) + Sheets("1").Cells(i + 2, 6) + Sheets("1").Cells(i + 1, 6)) Then
                Sheets("1").Cells(i - 5, 5).Interior.Color = RGB(255, 64, 64)
            End If
        End If
    Next i
    
End Sub

If Y = "Петя" And UserForm1.Password.Value = "80nawr" 
    ThisWorkbook.Sheets("заявки 2015").Columns("Q").EntireColumn.Hidden = False
    ThisWorkbook.Sheets("заявки 2015").Columns("R").EntireColumn.Hidden = False
    ThisWorkbook.Sheets("заявки 2015").Columns("P").EntireColumn.Hidden = False
    ThisWorkbook.Sheets("заявки 2015").Columns("T").EntireColumn.Hidden = False
    Sheets("2015").Visible = xlSheetVeryHidden
    Unload Me
    Range("P:R").Locked = False
    Range("O:O").Locked = False
    Worksheets("заявки 2015").EnableAutoFilter = True

For i = 1 To 1000
        If Sheets("çàÿâêè 2015").Cells(i, 18).Value = "a" Then
            If Not IsDate(Sheets("çàÿâêè 2015").Cells(i, 19).Value) Then Sheets("çàÿâêè 2015").Cells(i, 19).Value = Date
            Sheets("çàÿâêè 2015").Cells(i, 15) = "îïëà÷åíî"
            Sheets("çàÿâêè 2015").Cells(i, 15).Interior.Color = RGB(66, 230, 33)
        Else
            Sheets("çàÿâêè 2015").Cells(i, 19).Value = Empty
        End If
    Next i
    
      For Z = 1 To 1000
        If Y = "трали" Then
            If Sheets("çàÿâêè 2015").Cells(Z, 15).Comment Is Nothing Then
                Worksheets("çàÿâêè 2015").Unprotect Password:="1111"
                 If Sheets("çàÿâêè 2015").Cells(Z, 17).Value = "a" Then
                    With Worksheets("çàÿâêè 2015")
                        .Cells(Z, 15).Locked = False
                        .Cells(Z, 15).AddComment ("трали")
                    End With
                End If
            End If
        End If
        If Y = "траливали" Then
            If Sheets("çàÿâêè 2015").Cells(Z, 15).Comment Is Nothing Then
                Worksheets("çàÿâêè 2015").Unprotect Password:="1111"
                  If Sheets(2).Cells(Z, 17).Value = "a" Then
                    With Worksheets("çàÿâêè 2015")
                        .Cells(Z, 15).Locked = False
                        .Cells(Z, 15).AddComment ("траливали")
                    End With
            End If
        End If
    End If
    If Y = "тру" Then
            If Sheets("çàÿâêè 2015").Cells(Z, 15).Comment Is Nothing Then
                Worksheets("çàÿâêè 2015").Unprotect Password:="1111"
                 If Sheets("çàÿâêè 2015").Cells(Z, 17).Value = "a" Then
                    With Worksheets("çàÿâêè 2015")
                        .Cells(Z, 15).Locked = False
                        .Cells(Z, 15).AddComment ("тру")
                    End With
                End If
            End If
        End If
        
Sheets("çàÿâêè 2015").Protect Password:="1111", AllowFiltering:=True, UserInterfaceOnly:=True
Next Z

For Z = 1 To 20
        If Y = "Иванов И.А." Then
            If Sheets(2).Cells(Z, 17).Value = "a" Then
                With Worksheets("2015")
                    .Cells(Z, 17).Locked = False
                    .Cells(Z, 17).AddComment ("Иванов И.А.")
                End With
                
                Sheets(2).Cells(Z, 23).Interior.Color = RGB(66, 230, 33)
            End If
        End If
    Next Z

Sheets(2).Protect Password:="1111", UserInterfaceOnly:=True
    'на лист "Лист1" поставим защиту и разрешим пользоваться фильтром
    Sheets("заявки 2015").Protect Password:="1111", AllowFiltering:=True, AllowFormattingCells:=True
    Columns("A").Select

Sub x()
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If [A4] = "$$$" Then Exit Sub
Range("A5").Select
End Sub
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call x
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If [A4] = "$$$" Then Exit Sub
Range("A5").Select
End Sub

Private Sub CommandButton1_Click()
If UserForm1.Login.Text = "Шлей Т." And UserForm1.Password.Value = 123 Then
Лист2.Visible = xlSheetVisible
If UserForm1.Login.Text = "Иванов" And UserForm1.Password.Value = 123 Then
Лист3.Visible = xlSheetVisible
End If
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For i = 1 To 20
    If Sheets(1).Cells(i, 1) = "v" Then
    Sheets(1).Cells(i, 1) = Date
    End If
Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cell In Target
       If Not Intersect(cell, Range("Q2:Q1000")) Is Nothing Then
            With Range("R" & cell.Row)
               .Value = Now
               .EntireColumn.AutoFit
            End With
       End If
    Next cell
End Sub

Private Sub Workbook_Open()
Columns("Q:Q").Select
Selection.EntireColumn.Hidden = True
Dim Porol As Integer
Porol = Application.InputBox("Enter password", "Password")
    If Porol <> "123" Or Porol <> "321" Then
         ActiveWindow.Close False
   If Porol = "123" Then
        Columns("Q:Q").Select
        Selection.EntireColumn.Hidden = False
        Sheets("2015").Visible = False
    If Porol = "321" Then
        Columns("Q:Q").Select
        Selection.EntireColumn.Hidden = True
       
End If
End If
End If
End Sub