Sub Splitter()

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Dim h As Integer
 Dim wrksht As Worksheet
 Dim oListObj As ListObject

       For h = 2 To Sheets.Count
       Set wrksht = ActiveWorkbook.Worksheets(h)
       
       Set oListObj = wrksht.ListObjects(1)
 
        For Each cell In Range("ФИО")
        Sheets(wrksht.Name).Select
        FinalCol = Cells(1, Application.Columns.Count).End(xlToLeft).Column
        FinalRow = Cells(Application.Rows.Count, 1).End(xlUp).Row
        
        Range(oListObj.Name).AutoFilter Field:=FinalCol, Criteria1:=cell.Value

        Range(Cells(1, 1), Cells(FinalRow, FinalCol)).SpecialCells(xlCellTypeVisible).Copy
        ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
        ActiveSheet.Paste
        ActiveSheet.Name = cell.Value & "_" & Cells(2, FinalCol - 1).Value
        ActiveSheet.UsedRange.Columns.AutoFit
        Next cell
        Next

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
End Sub

= Table.SelectRows(#"Измененный тип", each [Дата окончания контракта] > #date(2020, 1, 16))

Sub RandW()
Dim wb As Workbook
Dim s As Worksheet
Dim AW As Window
Set wb = ActiveWorkbook
Set AW = ActiveWindow
Application.DisplayAlerts = False
'преобразование формул в значения на текущем листе
  ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 On Error Resume Next
 
  For Each s In Sheets
    If Not s Is ActiveSheet Then s.Visible = xlSheetVisible: s.Delete
  Next
 ' Application.Quit
ActiveWorkbook.SaveCopyAs wb.Path & "\" & Range("B1") & Range("B2") & ActiveSheet.Name & ".xls"

  Application.DisplayAlerts = True
End Sub

ActiveWorkbook.Queries("Тест").Delete

Sub Сохранить_как_SaveAs()
   ThisWorkbook.SaveAs ("C:\Users\Нина\Downloads\Пример1.xlsm")
End Sub