Sub листы()
     Dim sh As Worksheet
     Dim a()
     Dim i&, j&, rw&, nm
     Dim pth$
     a = Range(Cells(3, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)).Value 'диапазон берём в массив
     Set x = CreateObject("Scripting.Dictionary") 'создаём словарь
     For i = 2 To UBound(a) 'проходим по массиву от 2го элемента (1й шапка)
         x.Item(a(i, 2)) = 1 'отбираем уникальные значения из 2 колонки
     Next
     Application.ScreenUpdating = False 'отключаем обновление экрана
     pth = ThisWorkbook.Path & "\Сотрудники" 'путь к папке
     With CreateObject("Scripting.FileSystemObject")
         If Dir(pth, vbDirectory) <> "" Then 'проверяем есть ли папка
             .GetFolder(pth).Delete 'если есть, то удаляем
         End If
     End With
     MkDir (pth) 'создаём папку
     For Each nm In x.Keys 'проходим по ключам словаря (имена из таблицы)
         On Error Resume Next 'в случае ошибки выполняем следующее:
         Set sh = Sheets(nm) 'пусть sh будет лист с именем из списка
         'если листа с таким именем нет то добавляем его
         If sh Is Nothing Then Sheets.Add(, Sheets(Sheets.Count)).Name = nm
         With Sheets(nm) 'с листом с именем из списка
             For j = 1 To UBound(a, 2) 'проходим по колонкам массива
                 .Cells(1, j) = a(1, j) 'вносим шапку
                 rw = 2 'номер первой строки для выгрузки на лист
                 For i = 2 To UBound(a, 1) 'проходим по строкам массива
                     If a(i, 2) = nm Then 'если в строке присутствует нужное имя то
                         .Cells(rw, j) = a(i, j) 'вносим значение в ячейку из соотв. колонки массива
                         rw = rw + 1 'увеличиваем счётчик строк
                     End If
                 Next
             Next
             .Copy 'копируем лист, в новую книгу
             ActiveWorkbook.SaveAs Filename:=pth & "\" & nm & ".xls"
             ActiveWorkbook.Close False 'закрываем активную (созданную) книгу с сохранением
         End With
     Next
     Application.ScreenUpdating = True
End Sub