'-------------------
sDlm = Application.InputBox("Введите/выберите разделитель...", , , , , , , 2)
If sDlm = "False" Then Exit Sub
'-------------------

Sep = "" & sDlm & ""

Private Sub Workbook_Open()
Dim sh As Worksheet
For Each sh In Worksheets
    sh.EnableOutlining = True
    sh.Protect Password:="0123", UserInterfaceOnly:=True
Next
End Sub

=A1&ПОВТОР(ПРАВСИМВ(A1;5);3)

Sub Workbook_Open()
    If ActiveWorkbook.Name = "Мастер2.xls" Then Call NextRun
End Sub

Dim TimeToRun

Sub MyMacro()
With ThisWorkbook.Worksheets("Лист1")
    .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1) = Format(Now, "DD.MM.YYYY hh:mm:ss")
End With
ThisWorkbook.Save
Set FSO = CreateObject("Scripting.FileSystemObject")
'свои пути подставьте
FSO.CopyFile "d:\DOWNLOAD\Мастер2.xls", "d:\DOWNLOAD\Arhive\" & Date & ".xls", True
Call NextRun
End Sub

Sub NextRun()
    TimeToRun = Now + TimeValue("00:00:05") 'период пять секунд
    Application.OnTime TimeToRun, "MyMacro"
End Sub

Sub Finish()
    Application.OnTime TimeToRun, "MyMacro", , False
End Sub

FSO.CopyFile "d:\DOWNLOAD\Мастер2.xls", "d:\DOWNLOAD\Arhive\" & Format(Now, "hh_mm_ss") & ".xls", True

Function Seitkassym(iTbl As Range, arrClmn(), iPos$, iSc)
'iTbl - таблица исходных данных
'arrClmn - массив номеров столбцов для выборки из исходной таблицы
'iPos - искомая должность
'iSc - искомая оценка
Dim tmpArr$(), I&, J&, N&
arr = iTbl.Value
ReDim tmpArr(1 To Application.Caller.Rows.Count, 1 To 4): N = 1
For I = 1 To UBound(arr)
    If Trim(arr(I, 2)) = iPos And Trim(arr(I, 8)) = iSc Then
        For J = 1 To UBound(arrClmn)
            tmpArr(N, J) = arr(I, arrClmn(J))
        Next
        N = N + 1
    End If
Next
Seitkassym = tmpArr
End Function

Range("AW12")