Function СчетУникЗначений(Диапазон As Range) As Long
        Dim cell As Range
        Dim dict As Object
        Set dict = CreateObject("Scripting.Dictionary")

        For Each cell In Диапазон
            If cell.Rows.Hidden = False And cell.Columns.Hidden = False Then
                If Not IsEmpty(cell.Value) Then
                    If Not dict.exists(cell.Value) Then
                        dict.Add cell.Value, 1
                    End If
                End If
            End If
        Next cell

        СчетУникЗначений = dict.Count
    End Function

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ' Ваш макрос будет запускаться при каждом изменении активного листа
ActiveCell.Show 'активная ячейка в зоне видимости

End Sub

Sub PeopleButton()
'
' PeopleButton Макрос
' Список активных людей в доме, фильтрует данные прибывших и не уехавших
    Sheets("Список").Select
    
    On Error Resume Next: ActiveSheet.ShowAllData: On Error GoTo 0
    'добавил замену слова архив на пусто
        Columns("R:S").Replace What:="архив", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula
        
    ActiveSheet.ListObjects("Список").Range.AutoFilter Field:=19, Criteria1:= _
        "="
    ActiveSheet.ListObjects("Список").Range.AutoFilter Field:=18, Criteria1:= _
        "="
    ActiveWindow.SmallScroll Down:=-4
    Range("B2").Select
End Sub

Sub Arhiv27()
' Фильтр скрывает строки списка, кроме тех где есть значения в столбце "уехал" и Убыл без предупр""
    Sheets("Список").Select
    On Error Resume Next: ActiveSheet.ShowAllData: On Error GoTo 0
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'поиск самой последней пустой строки в таблице
For i = 2 To LastRow 'цикл  до последней пустой строки
    If Cells(i, 18) = "" And Cells(i, 19) = "" Then 'по условию в ячеках столбцов R и S пусто
        Cells(i, 19) = "архив" 'пишем "архив"
    End If
Next
    ActiveSheet.ListObjects("Список").Range.AutoFilter Field:=19, Criteria1:=("<>архив") ' Фильтр скрывает строки с "архив" используя текстовый филтр... не равно...архив
End Sub

Sub Макрос1()
For i = 1 To Selection.Rows.Count / 3
    Rows(Selection.Row + (3 * i) + i - 1).Insert
Next
End Sub

Sub Макрос1()
n = Selection.Rows.Count   'Последняя  строка по счету выделенном диапазоне
k = 0                      'Счетчик количества добавленных строк
For i = 1 To n / 3 'цикл
r = Selection.Row + 3 * i  '№ строки на листе (первой  строки по счету в выделенном диапазоне-актив.Ячейка "ActiveCell"+3*i)
Rows(r + k).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'добавляем строку
k = k + 1 'Счетчик количества добавленных строк ,можно написать k=i
Next 'повторяем цикл
End Sub

=ЕСЛИ(MASTER!L11="";"";"x")

=ГИПЕРССЫЛКА("C:\Users\eng_mgo\Desktop\Документы\"&$A2&"\"&(ТЕКСТ($H2;"ДД.ММ"));"Клик")