Function iDate(cell$) As Date
Dim mo As Object
 With CreateObject("VBScript.RegExp")
     .Global = True
   If InStr(1, cell, ".") > 0 Then
      .Pattern = "(([0-2]?\d{1})|([3][0,1]{1}))\.[0,1]?\d{1}\.(([1]{1}[9]{1}[9]{1}\d{1})|([2-9]{1}\d{3}))"
     If .test(cell) Then
       iDate = .Execute(cell)(0)
     Else
       iDate = ""
     End If
   ElseIf InStr(1, cell, "/") > 0 Then
      .Pattern = "([0,1]?\d{1})\/(([0-2]?\d{1})|([3][0,1]{1}))\/[0,1]?\d{1}\/(([1]{1}[9]{1}[9]{1}\d{1})|([2-9]{1}\d{3}))"
        iDate = .Replace(cell, "$2.$1")
      Else
     iDate = ""
   End If
 End With
End Function

    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD

        .InitialFileName = ThisWorkbook.Path

Function GetNomer(stroka As String)
Dim arr
  arr = Split(stroka)
  GetNomer = arr(UBound(arr))
End Function

PasteSpecial xlPasteColumnWidths

Sub ClearForm()
 Dim ws As Worksheet
 Dim sh As Shape
    Set ws = ThisWorkbook.Sheets("start")
    For Each sh In ActiveSheet.Shapes
       If sh.Name Like "Check Box *" Then
            sh.Delete
        End If
    Next sh
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub 'выделено больше одной ячейки
  If Not Intersect(Target, Columns("P")) Is Nothing Then
    Cells.Interior.ColorIndex = xlColorIndexNone
    Range(Cells(Target.Row, 1), Cells(Target.Row, 30)).Interior.Color = RGB(234, 244, 234) 'светло-зеленый
  Else
    Cells.Interior.ColorIndex = xlColorIndexNone
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub 'выделено больше одной ячейки
  If Not Intersect(Target, Columns("P")) Is Nothing Then
    Cells.Interior.ColorIndex = xlColorIndexNone
    Range(Cells(Target.Row, 1), Cells(Target.Row, 30)).Interior.Color = RGB(234, 244, 234) 'светло-зеленый
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub 'выделено больше одной ячейки
  If Not Intersect(Target, Columns("P")) Is Nothing Then
    Range(Cells(Target.Row, 1), Cells(Target.Row, 30)).Interior.Color = RGB(234, 244, 234) 'светло-зеленый
  End If
End Sub

If Target.Cells.Count > 1 Then Exit Sub 'выделено больше одной ячейки
    If Not Intersect(Target, Columns("P")) Is Nothing Then

Range(Cells(Target.Row,1), Cells(Target.Row,30)).Interior.Color = RGB(234, 244, 234) 'светло-зеленый

Sub ifound()
Dim FoundCell As Range
Dim List1 As Worksheet
Dim Tsena As Double
Set List1 = ThisWorkbook.Worksheets("Лист1")
    Set FoundCell = Columns("A").Find(List1.Range("E4"), , xlValues, xlPart)
    List1.Range("S4") = Cells(FoundCell.Row, "L")
    MsgBox "Значение VIN " & List1.Range("E4") & " находится в строке: " & FoundCell.Row
End Sub

If ActiveWorkbookt.ProtectContents = True Then

Function LastSkobki(cell$) As String
Dim mo As Object
Dim n As Integer
 With CreateObject("VBScript.RegExp")
   .Global = True
   .Pattern = "\((.+?)\)"
   Set mo = .Execute(cell)
     LastSkobki = Replace(cell, mo(mo.Count - 1), "")
 End With
End Function

'Иванов Иван Иванович               Выделить И.О.Фамилия
Function iFIO(cell As String) As String
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = False
     .Pattern = "([А-ЯЁ][а-яё ]+)([А-ЯЁ])[а-яё ]+([А-ЯЁ])[а-яё ]+"
     If .test(cell) Then
       iFIO = .Replace(cell, "$2.$3. $1")
     End If
 End With
End Function

ActiveSheet.Pictures.Insert

ActiveSheet.Pictures.Add

Columns(iLastCol).AutoFit

Cells(4, iLastCol).EntireColumn.AutoFit

Dim iLastCol As Integer
iLastCol = Cells(4 , Columns.Count).End(xlToLeft).Column

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
If Target.Count > 1 Then Exit Sub
  If Target.Value > 0 And Target.Value < =31 Then
    Target = DateSerial(Year(Now), Month(Now), Target)
    Target.NumberFormat = "dd.mm.yyyy"
  Else
    Target = ""
  End If
      Application.EnableEvents = True
End Sub