Option Explicit
Private Comb_Arrow As Boolean
Public sootv As Boolean
Dim tb As ListObject

Private Sub ComboBox1_Change()
'-------------------------------------
'Поле со списком - это поле со списком ActiveX со следующими свойствами:
'Name = ComboBox1
'ListFillRange = blank
'MatchEntry = 2 - fmMatchEntryNone
'MatchRequired = False
'------------------------------------
Dim i As Long
Dim lReply As Long
Dim lRow As Long

Set tb = ThisWorkbook.Sheets("Сводная").ListObjects("Сводная")

    If Not Comb_Arrow Then
    With Me.ComboBox1
        .List = tb.ListColumns("ФИО").DataBodyRange.Value
        .ListRows = Application.WorksheetFunction.Min(15, .ListCount)
        .DropDown
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next i
                .DropDown
            End If
            If .ListCount > 0 Then
                sootv = False
            Else
                .List = Array("[не найдено соответствия]")
                sootv = True
            End If
    End With
    End If
  
End Sub

Private Function Update()
Me.ComboBox1.List = tb.ListColumns("ФИО").DataBodyRange.Value
End Function

Private Sub CommandButton1_Click()
    Dim wsSource As Worksheet
    Dim lo As ListObject
    Dim rngHeaders As Range
    Dim rowFound As Range
    Dim newSheet As Worksheet
    
    On Error GoTo ErrHandler
    
    ' Установка ссылок на исходный лист и объект таблицы
    Set wsSource = ThisWorkbook.Sheets("Сводная")
    Set lo = wsSource.ListObjects("Сводная")
    
    ' Проверка введенного значения
    If Me.ComboBox1.Value = "" Then
        MsgBox "Введите ФИО в поле ввода", vbCritical
        Exit Sub
    End If
    
    ' Поиск строки с указанным ФИО
    Set rowFound = lo.DataBodyRange.Find(What:=Me.ComboBox1.Value, LookIn:=xlValues, _
                                         lookAt:=xlWhole)
    
    If Not rowFound Is Nothing Then
        ' Создаем новый лист с именем найденного ФИО
        Set newSheet = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1)) 

        newSheet.Name = Me.ComboBox1.Value
       
        Set rngHeaders = lo.HeaderRowRange.EntireRow
        rngHeaders.Copy Destination:=newSheet.Range("A1")
        
        rowFound.EntireRow.Copy Destination:=newSheet.Range("A2")
                          
        Call Форматирование_Данных
        
        MsgBox "Данные по ФИО '" & Me.ComboBox1.Value & "' выбраны", vbInformation
    Else
        MsgBox "ФИО '" & Me.ComboBox1.Value & "' не найдено в таблице.", vbExclamation
    End If
    
   ' Устанавливаем формулу в K5 текущего листа
    Cells(5, 8).Value = Me.ComboBox1.Value
        
ExitHere:
    Exit Sub
ErrHandler:
    MsgBox "Ошибка при выполнении операции: " & Err.Description, vbCritical
    Resume ExitHere
   
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCod As MSForms.ReturnInteger, ByVal Shift As Integer)
    Comb_Arrow = (KeyCod = vbKeyUp) Or (KeyCod = vbKeyDown)
    If KeyCod = vbKeyReturn Then
        CommandButton1_Click ' Запуск основного макроса
    End If
End Sub

Private Sub Workbook_Open()
Dim rng As Range
Dim cell As Range
Dim i As Integer
Dim tb As ListObject

Set tb = ThisWorkbook.Sheets("Сводная").ListObjects("Сводная")

Set rng = tb.ListColumns("ФИО").DataBodyRange

With ThisWorkbook.Sheets("Поиск").ComboBox1
    .Clear
    For Each cell In rng
        .AddItem cell.Value
    Next cell
End With

End Sub