Private Sub CommandButton4_Click()
TextBox5.Value = Cells(Rows.Count, 48).Row
End Sub   

Sub ляляля4()
Dim FileN$
FileN = ThisWorkbook.Path & "/" & Date & ".xls"
ThisWorkbook.Sheets(2).Copy
For Each c In Cells.SpecialCells(xlCellTypeFormulas): c.Value = c: Next
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close
End Sub

  Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cell In Target
            If Not Intersect(cell, Range("A1:A496") Is Nothing Then
                ActiveSheet.Cells(1, 10).Value = CreateObject("WScript.Network") .UserName
           End If
        Next cell
    End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim r As Long
Dim str As String
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
str = Target.Value
Application.EnableEvents = False
r = Cells(Rows.Count, 2).End(xlUp).Row
Range("A4:A100" & r).ClearContents
Target.Value = str
End If
If Not Intersect(Target, Range("A4:A100"  ;)  ) Is Nothing Then
Target.Offset(0, 12).Select
End If
Application.EnableEvents = True
ActiveSheet.Protect
End Sub

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
 If Target.Column = 14 Then
 Sheets(2).Select
 ActiveSheet.PrintOut
 Sheets(1).Select
 End If
End Sub