.HTMLBody = RangetoHTML(rngg)

Sub Send_letter()
'Понимаем, кто делает отчет

Dim iName As String
iName = Environ("UserName")

Sheets("Users").Select
Range("B1").Select
Range("B1") = iName

Calculate
'ДЛЯ ПЕРВОГО ПИСЬМА
Sheets("Letter 1").Select

'Находим последнюю строчку
Range("A8").Select
Selection.End(xlDown).Select
a = Selection.Row
b = "A" & (a + 2)

'Копируем нижнюю часть письма
Range("I4:I16").Select
Selection.Copy
Range(b).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Range для тела письма
c = "A4:G" & (a + 15)

'Range для адресантов Main
Sheets("Users").Select
Range("F3").Select
Selection.End(xlDown).Select
d = Selection.Row
e = ""
For N = 4 To d
    e = e + Range("F" & N).Text + ";"
Next N

'Range для адресантов Copy
Range("H3").Select
Selection.End(xlDown).Select
f = Selection.Row
g = ""
For N = 4 To f
    g = g + Range("H" & N).Text + ";"
Next N
Sheets("Letter 1").Select

' Создание первого письма
    Dim rngg As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rngg = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rngg = ActiveWorkbook.Worksheets("Letter 1").Range(c)
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

  If rngg Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

' указание папки откуда берутся вкладываемые файлы
    MyFolderM = "C:\путь                 ' МЕНЯЕТСЯ"
    MyFileM = Dir(MyFolderM & "\*.pdf")
    MyFolder = "C:\путь"                   ' МЕНЯЕТСЯ
    MyFile = Dir(MyFolder & "\*.pdf")
    
    On Error Resume Next
    With OutMail
        .To = e
        .CC = g
        .BCC = ""
        .Subject = ActiveWorkbook.Worksheets("Letter 1").Range("A3")
        .HTMLBody = RangetoHTML(rngg)  'HTMLBody
        .Attachments.Add (MyFolderM & "\" & MyFileM)
        Do While MyFile <> ""
            .Attachments.Add (MyFolder & "\" & MyFile)
            MyFile = Dir
        Loop
      '  .Attachments.Add "\\BETTA\Deals.xlsx"
        .Display   'or use .Display use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

' Удаляем нижную часть для следующего дня
Sheets("Letter 1").Select
d = "A" & (a + 2) & ":A" & (a + 14)
Range(d).Select
Selection.ClearContents
Range("B1").Select

End Sub