Sub Hidden()
    Sheets(Array("1.16", "1.8", "1.4", "1.2")).Select
    Sheets("1.16").Activate
    Range("H:S,W:AH,AL:AW,BA:BL,BP:CA,CE:CP,CT:DE,DI:DT,DX:EI,EM:EX").Select
    Range("EX1").Activate
    Selection.EntireColumn.Hidden = True
End Sub

UserForm1.ComboBox1.RowSource = ThisWorkbook.Sheets("ФИО").Range("A2:A" & ThisWorkbook.Sheets("ФИО").Cells(ThisWorkbook.Sheets("ФИО").Rows.Count, 1).End(xlUp).Row)

Private Sub UserForm_activate() 
        UserForm1.ComboBox1.RowSource = ThisWorkbook.Sheets("ФИО").Range("A2:A" & Sheets("ФИО").Cells(Rows.Count, 1).End(xlUp).Row)
End Sub

Private Sub Workbook_Open()
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
    With Windows("Для учета рабочего времени1.xlsm")
        .Visible = False
    End With
    Call UserForm1.Show
End Sub

Range("B8:B518").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=И($D8>0;ИЛИ($B8=0;ИЛИ(И($D8>0;$E8=0;$J8=0);И($D8>0;$E8>0;ИЛИ($J8=0;$K8=0));И($D8>0;СУММ($J8:$P8")=0))))"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True

"=И($D8>0;ИЛИ($B8=0;ИЛИ(И($D8>0;$E8=0;$J8=0);И($D8>0;$E8>0;ИЛИ($J8=0;$K8=0));И($D8>0;СУММ($J8:$" & Cells(8, 15 + Range("O3").Value) & ")=0))))"

Set GCell = Sheets("Лист1").Columns("A:A").FindNext(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole, after:=№Address)

Sub example
iResult = InputBox("Укажите номер ", "Введите цифру")
 
If iResult = "" Then
    MsgBox "Ни одного значения не введено!", vbCritical
Exit Sub
 
ElseIf iResult <> 0 Then
Set GCell = Sheets("Лист1").Columns("A:A").Find(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole)
If GCell Is Nothing Then
MsgBox "Цифра " & iResult & " не найдена", vbExclamation, "Ошибка"
Exit Sub
Else

If Not GCell Is Nothing Then
    №Address = GCell.Address
Do
Sheets("Лист1").Range(GCell.Offset(0, 14), GCell.Offset(0, Range("Лист2!А1").Value - 1 + 13)).Copy ' определяю количество столбцов в этой строке, из ячейки в другом листе, которые надо скопировать
Sheets("Лист2").Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Set GCell = Sheets("РЕГИСТРАЦИЯ").Columns("B:B").FindNext(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole, after:=№Address)
Loop While Not GCell Is Nothing And GCell.Address <> №Address
End If
end 

Sub example
iResult = InputBox("Укажите номер ", "Введите цифру")

If iResult = "" Then
    MsgBox "Ни одного значения не введено!", vbCritical
Exit Sub

ElseIf iResult <> 0 Then
Set GCell = Sheets("Лист1").Columns("A:A").Find(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole)
If GCell Is Nothing Then
MsgBox "Цифра " & iResult & " не найдена", vbExclamation, "Ошибка"
Exit Sub
Else
Sheets("Лист1").Range(GCell.Offset(0, 14), GCell.Offset(0, Range("Лист2!А1").Value - 1 + 13)).Copy ' определяю количество столбцов в этой строке, из ячейки в другом листе, которые надо скопировать
Sheets("Лист2").Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
end sub

Dim Q1 As String

Q1 = App.Data.Value & App.Time.Value

Dim Q2 As Range

Set Q2 = AppListObj.ListColumns.Item(7).Range.Find(Q1, LookIn:=xlValues, lookat:=xlWhole)

Sub AddApp() ' Добавление записи
    Set ShApp = ThisWorkbook.Worksheets("Запись")
    Set AppListObj = ShApp.ListObjects("Запись_Tb")
    
    Set AppListRow = AppListObj.ListRows.Add
    
    Dim Q1 As Date
    Dim Q2 As Range
    
    Q1 = App.Data.Value & " " & App.Time.Value
    Set Q2 = AppListObj.ListColumns.Item(7).Range.Find(Q1, lookat:=xlWhole)
    
    If Q2 Is Nothing Then
    
    AppListRow.Range(1) = App.txb_surname.Value
    AppListRow.Range(2) = App.txb_name.Value
    AppListRow.Range(3) = App.txb_ptr.Value
    AppListRow.Range(4) = App.txb_mobile.Value
    AppListRow.Range(5) = App.Data.Value
    AppListRow.Range(6) = App.Time.Value
    
    Else
     MsgBox "Время уже занято!"
    End If

Option Explicit

Dim ShApp As Worksheet
Dim AppListObj As ListObject
Dim AppListRow As ListRow

Sub AddApp() ' Добавление записи
    Set ShApp = ThisWorkbook.Worksheets("Запись")
    Set AppListObj = ShApp.ListObjects("Запись_Tb")
    
    Set AppListRow = AppListObj.ListRows.Add
    
    Dim Q1 As Date
    Dim Q2 As Range
    
    Set Q1 = CDate(App.Data.Value & App.Time.Value)
    Set Q2 = AppListObj.ListColumns.Item(5).Range.Find(Q1, lookat:=xlWhole)
    
    If Q2 Is Nothing Then
    
    AppListRow.Range(1) = App.txb_surname.Value
    AppListRow.Range(2) = App.txb_name.Value
    AppListRow.Range(3) = App.txb_ptr.Value
    AppListRow.Range(4) = App.txb_mobile.Value
    AppListRow.Range(5) = App.Data.Value
    AppListRow.Range(6) = App.Time.Value
    
    Else
     MsgBox "Время уже занято!"
    End If
    
End Sub