Добавить в макрос выбор фамилии сотрудника из списка

[cadargo]

Есть написанный мной макрос для оценки сотрудников, со скрытиями листов что бы никто не видел что поставили другие. Проблема в том что не знаю как правильно сделать чтобы был выпадающий списой с ФИО сотрудников.
Вот сам текст макроса:

Sub Кнопка2_Щелчок()
Do
Worksheets("Лист2").Visible = xlSheetVisible

Worksheets("Лист2").Select
' Поиск ближайшей пустой ячейки в текущем столбце
Do While Not IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop
If strSum15 <> "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum15 <> "" Then Worksheets("Лист1").Select
If strSum15 <> "" Then Exit Sub

lngRow = Range("A65536").End(xlUp).Row + 1
' Вводим свою фамилию
strDate = InputBox("Фамилия ")
If strDate = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strDate = "" Then Exit Sub
' Вводим фамилию сотрудника
Мне надо что бы сдесь был выбор из списка ФИО.
strDate = InputBox("Фамилия сотрудника")
If strDate2 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strDate2 = "" Then Exit Sub
' Ввод оценок
strSum = InputBox("Вводим оценку1")
If strSum = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum = "" Then Exit Sub
strSum2 = InputBox("Вводим оценку2")
If strSum2 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum2 = "" Then Exit Sub
strSum3 = InputBox("Вводим оценку3")
If strSum3 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum3 = "" Then Exit Sub
strSum4 = InputBox("Вводим оценку4")
If strSum4 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum4 = "" Then Exit Sub
strSum5 = InputBox("Вводим оценку5")
If strSum5 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum5 = "" Then Exit Sub
strSum6 = InputBox("Вводим оценку6")
If strSum6 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum6 = "" Then Exit Sub
strSum7 = InputBox("Вводим оценку7")
If strSum7 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum7 = "" Then Exit Sub
strSum8 = InputBox("Вводим оценку8")
If strSum8 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum8 = "" Then Exit Sub
strSum9 = InputBox("Вводим оценку9")
If strSum9 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum9 = "" Then Exit Sub
strSum10 = InputBox("Вводим оценку10")
If strSum10 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum10 = "" Then Exit Sub
strSum11 = InputBox("Вводим оценку11")
If strSum11 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum11 = "" Then Exit Sub
strSum12 = InputBox("Вводим оценку12")
If strSum12 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum12 = "" Then Exit Sub
strSum13 = InputBox("Вводим оценку13")
If strSum13 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum13 = "" Then Exit Sub
strSum14 = InputBox("Вводим оценку14")
If strSum14 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum14 = "" Then Exit Sub
strSum15 = InputBox("Вводим оценку15")
If strSum15 = "" Then Worksheets("Лист2").Visible = xlSheetHidden
If strSum15 = "" Then Exit Sub
' Запись данных в ячейки
Cells(lngRow, 1) = strDate
Cells(lngRow, 2) = strDate2
Cells(lngRow, 3) = strSum
Cells(lngRow, 4) = strSum2
Cells(lngRow, 5) = strSum3
Cells(lngRow, 6) = strSum4
Cells(lngRow, 7) = strSum5
Cells(lngRow, 8) = strSum6
Cells(lngRow, 9) = strSum7
Cells(lngRow, 10) = strSum8
Cells(lngRow, 11) = strSum9
Cells(lngRow, 12) = strSum10
Cells(lngRow, 13) = strSum11
Cells(lngRow, 14) = strSum12
Cells(lngRow, 15) = strSum13
Cells(lngRow, 16) = strSum14
Cells(lngRow, 17) = strSum15
Loop
End Sub
Помогите потому что сам не могу разобраться список будет на "Лист4" количество ФИО разное так как в структурных подразделениях разное количество людей.

[EducatedFool]

Проще этот макрос удалить, и написать его заново

А чтобы написать заново - нужно видеть ваш файл Excel

[cadargo]

Excel'евский файл выложу вечером так как на работе выгрузка в инет забанена.

[cadargo]

Вот Excel'евский файл.
test.zip

[IgorGO]

может так проще будет?
см.вложение

[cadargo]

Такой вариант не подходит так как сотрудники не должны видеть кто уже выставил оценки, плюс коэффициент оценки руководителя выше чем у коллег и подчиненных.

[IgorGO]

лист "Оценки" скройте под паролем - никто ничего не увидит.
как что должно считаться никто кроме Вас не знает (я - точно не знаю). а файл выложил потому что было полчаса времени, которое я не знал чем занять, вот и занял...
и вооще-то, пожалуйста.

[cadargo]

спасибо за вариант который предложили.
и все таки в том виде в котором я сделал можно сделать выпадающий списой или нет???

[IgorGO]

возможно...

[keechva]

Скажите, это просто выпадающий список в ячейке или в макросе? не могу залезть посмотреть - пароль стоит. может выложите пароль?