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_SelectionChange(ByVal Target As Range)
 Dim myRange As Range
 Set myRange = Worksheets("Çàÿâêà íà ïîäêëþ÷åíèå").Range("O:R")

 If Application.Intersect(Target, myRange) Is Nothing Then
  Application.CellDragAndDrop = True
  
 Else
  Application.CellDragAndDrop = False
  
 End If
 
 End Sub
 
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("O:R")) Is Nothing Then Cancel = True

End Sub

Sub Merge_Cell_With_Format()
Dim rRange As Range, rMrgRange As Range, wsTempSh As Worksheet, wsActSh As Worksheet
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set wsActSh = ActiveSheet: Set wsTempSh = Sheets.Add(, Sheets(Sheets.Count)): wsTempSh.Name = "Áðàêîçÿáóëà_âîò_òàê_ñàì_â_øîêå"
wsActSh.Activate
Set rRange = Selection: rRange.Copy wsTempSh.Range(rRange.Address)
Set rMrgRange = wsTempSh.Range(rRange.Address)
rMrgRange.Merge: rMrgRange.Copy: rRange.PasteSpecial xlPasteFormats: wsTempSh.Delete
Set wsActSh = Nothing: Set wsTempSh = Nothing: Set rMrgRange = Nothing: Set rRange = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = 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

For Each cCell In ActiveWindow.RangeSelection.columns(1)

For each 

Sub Кнопка2_Щелчок()
Dim cCell As Range
For Each cCell In ActiveWindow.RangeSelection.column(1)
Application.CutCopyMode = False
Selection.Hyperlinks.Delete
Selection.NumberFormat = "General"
Selection.Value = Selection.Value
     
Next
 
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