Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("B1:R1")
If Not Intersect(Target, rng) Is Nothing Then
    If WorksheetFunction.CountA(rng) = 17 Then
           Call SendAllMassages
    End If
End If
End Sub

Sub SendAllMassages()

Dim i As Integer
Dim Phone As String
Dim Message As String
Dim iV As Double
'i = 3 'Начинаем перебор строк с третьей строки
'While Cells(i, 2) <> "" 'Запускаем цикл, который будет работать пока не увидит в очередной i-той ячейке второго столбца пустое значение
'    Phone = CStr(Cells(i, 2)) 'Номер телефона из i-ой строки второго столбца сохраняем в переменную Phone
'    Message = CStr(Cells(i, 3)) 'Текст сообщения из i-ой строки третьего столбца сохраняем в переменную Message
'    Call SendWhatsappMassage(Phone, Message) 'Вызываем функцию отправки сообщения
'    i = i + 1 'Добавляем к счетчику строк еденицу
'Wend 'Переходим в начало цикла

iV = Range("R1").Value
Phone = "+79999999999"
Message = "Напоминаю, что необходимо произвести оплату по продаже груза от " & Format(Now, "[$-FC22]DD.MM.YY " & "года") & ", сумма к перечислению: " & iV
Call SendWhatsappMassage(Phone, Message)

End Sub

Sub SendWhatsappMassage(Phone As String, Message As String)
    
    ThisWorkbook.FollowHyperlink "https://api.whatsapp.com/send?phone=" & Phone & "&text=" & Message 'Переходим по ссылке

    Application.Wait (Now + TimeValue("00:00:10")) 'Ждем, когда отработает браузер
    ActiveWindow.Application.SendKeys ("(~)")      'Нажимаем кнопку Enter для перехода в приложение Whatsapp
    Application.Wait (Now + TimeValue("00:00:10")) 'Ждем, когда отработает приложение
    ActiveWindow.Application.SendKeys ("(~)")      'Опять Нажимаем кнопку Enter для отправки сообщения
    Application.Wait (Now + TimeValue("00:00:10")) 'Ждем, когда отработает приложение
    ActiveWindow.Application.SendKeys ("%({TAB})") 'Жмем alt+tab для перехода обратно в браузер
    Application.Wait (Now + TimeValue("00:00:10")) 'Ждем, когда отработает приложение
    ActiveWindow.Application.SendKeys ("^({F4})")  'Жмем ctrl+F4 для того чтобы закрыть вкладку браузера, открытую ранее

End Sub

 ThisWorkbook.FollowHyperlink ("C:\Users\EXPRESSING\AppData\Local\WhatsApp\WhatsApp.exe") & Phone & "&text=" & Message

Private Sub Worksheet_SelectionChange(ByVal Target As Range)With Range("A8")
.Value = "№" & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 1, "[$-FC22]M") & " от " & Format(DateSerial(Year(Now), Month(Now) + 1, 1) - 1, "[$-FC22]D MMMM 20 YY г.")
Dim s As String
Dim v As Variant
s = .Value
For Each v In Array("т", "2")
    s = Replace(s, v, Chr(160))
Next
a = Split(s, Chr(160))
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Range("A8")
.Value = "№" & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 1, "[$-FC22] M ") & "от" & Format(DateSerial(Year(Now), Month(Now) + 1, 1) - 1, "[$-FC22] D MMMM 20 YY г.")
Dim s As String
Dim v As Variant
s = .Value
For Each v In Array("от", "20")
    s = Replace(s, v, Chr(160))
Next
a = Split(s, Chr(160))
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Range("A19")
.FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
& " полученной от реализации перевозок по договору №19 – МАН от « 21 » августа 20 15 года," _
& " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&" _
& "'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
.Formula = .Value
.Characters(116, 9).Font.Italic = True
.Characters(116, 9).Font.Underline = True

Dim s As String
Dim v As Variant
s = .Value
For Each v In Array("(", ")")
    s = Replace(s, v, Chr(160))
Next
a = Split(s, Chr(160))
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
        
Dim m As Variant
Dim n As Variant
m = .Value
For Each n In Array(" ")
    m = Replace(m, n, Chr(160))
Next
a = Split(m, Chr(160))
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 19, 23, 26
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
End Sub