=Inside(Polygons!A$2:B$186;Coordinates!$D2;Coordinates!$C2)

Option Explicit
 
'Модуль почтовой рассылки
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim Rn As Range
    Set Rn = Intersect(Target, Range("A1"))
    If Not Rn Is Nothing Then
        If Rn.Value > 2 Then Send_Mail
    End If
 End Sub
 
Private Sub Send_Mail()
Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
    Dim oCDOCnf As Object, oCDOMsg As Object
    Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String
    Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String
    On Error Resume Next
    'sFrom – как правило совпадает с sUsername
    SMTPserver = "smtp.yandex.ru"    ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
    sUsername = "yourmail"    ' Учетная запись на сервере
    sPass = "yourpaword"    ' Пароль к почтовому аккаунту
 
    If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation: Exit Sub
    If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation: Exit Sub
    If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation: Exit Sub
 
    sTo = "phoenix.solar@yandex.ru"    'Кому
    sFrom = "yourmail"    'От кого
    sSubject = "Автоотправка"    'Тема письма
    sBody = "Привет"    'Текст письма
    sAttachment = ""С:\Temp\Autosms-06-03-2020-10-29.xls""    'Вложение(полный путь к файлу)
    'Проверка наличия файла по указанному пути
    If Dir(sAttachment, vbDirectory) = "" Then sAttachment = ""
    'Назначаем конфигурацию CDO
    Set oCDOCnf = CreateObject("CDO.Configuration")
    With oCDOCnf.Fields
        .Item(CDO_Cnf & "sendusing") = 2
        .Item(CDO_Cnf & "smtpauthenticate") = 1
        .Item(CDO_Cnf & "smtpserver") = SMTPserver
        'если необходимо указать SSL
        .Item(CDO_Cnf & "smtpserverport") = 465 'для Яндекса и Gmail 465
        .Item(CDO_Cnf & "smtpusessl") = True
        '=====================================
        .Item(CDO_Cnf & "sendusername") = sUsername
        .Item(CDO_Cnf & "sendpassword") = sPass
        .Update
    End With
    'Создаем сообщение
    Set oCDOMsg = CreateObject("CDO.Message")
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .BodyPart.Charset = "koi8-r"
        .From = sFrom
        .To = sTo
        .Subject = sSubject
        .TextBody = sBody
        If Len(sAttachment) > 0 Then .AddAttachment sAttachment
        .Send
    End With
 
    Select Case Err.Number
    Case -2147220973: sMsg = "Нет доступа к Интернет"
    Case -2147220975: sMsg = "Отказ сервера SMTP"
    Case 0: sMsg = "Письмо отправлено"
    Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewLine & "Описание ошибки: " & Err.Description
    End Select
    MsgBox sMsg, vbInformation
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

Sub Копирование_данных()
   
    
    Dim lr
    With Sheets("Журнал проведения настройки")
        lr = .Cells(65536, 2).End(xlUp).Row + 1
           .UsedRange.Clear
    End With
    
    With Sheets("Приглашение").Range("a2").CurrentRegion                  ' первая строка  копирования
'        .Columns("H:I").Hidden = -1                                        ' столбцы которые необходимо скрыть
        .AutoFilter 6, "Приглашен"                                        ' Фильтр базового значения
        If lr = 4 Then
            .Copy Sheets("Журнал проведения настройки").Range("a2")             ' с какой ячейки вставляем во второй лист
        Else
       
            .Offset(1).Copy Sheets("Журнал проведения настройки").Range("a" & lr)
            .Parent.AutoFilterMode = 0

        End If
        
        
    End With

End Sub

Sub excample()
Application.ScreenUpdating = False
Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
With Me.Sort
    With .SortFields
        .Clear
        .Add Key:=Range("c3:c101"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    End With
    .SetRange Range("b3:n101")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub