Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Row < 8 And Target.Column = 5 Then
    spisok = ListObjects("reestr").Range.Value2
        For i = 1 To UBound(spisok)
        If Target.Value = spisok(i, 1) Then Cells(Target.Row, Target.Column) = spisok(i, 2): Exit Sub
    Next i
End If
End Sub

=СЧЁТЕСЛИМН(Дни_недели;F$36;ИНДЕКС(График[[1]:[31]];ПОИСКПОЗ($C37;График[ФИО];0););"Вых.")

Private Sub Fr_Kl_Fon_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Lbl_FrKl_AddKlienta.BackStyle = 0
End Sub

Private Sub Lbl_FrKl_AddKlienta_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Lbl_FrKl_AddKlienta.BackStyle = 1
Lbl_FrKl_AddKlienta.BackColor = 255
End Sub

Function Stroka() As Long
    Stroka = Selection.Row
End Function

=СЧЁТЕСЛИ($B$2:$B$5;A2)>0

Sub Дата_из_текста()
    Dim r, c As Range
    With ActiveSheet
        Set r = Intersect(.UsedRange, .[a:a]).Offset(1)
        r.FormulaLocal = r.FormulaLocal
        r.NumberFormat = "dd.mm.yyyy"
        For Each c In r
            .Cells(c.Row, c.Column) = Format(c.Value2, "dd.mm.yyyy")
        Next c
    End With
End Sub

Public s As Range
Sub Copy()
Set s = Selection
s.Copy
End Sub
Sub Paste()
Selection.PasteSpecial xlPasteValues
Selection.PasteSpecial xlPasteFormats
s.ClearContents
End Sub

Sub Paste ()
Selection.PasteSpecial xlPasteValues
Selection.PasteSpecial xlPasteFormats
End Sub