Bdtjtk

First of all, i'm so beginner with VBA.

I'm sending some excel ranges / selections every day manually by email, so I'm trying to find a way to automate it by pressing a button in the excel sheet.

I'm facing an issue of pasting many selections under each other, like after pasting the first range, then press enter, then past the second selection and so on ..

below is what I use:

Private Sub CommandButton1_Click()



    Dim rng As Range

    Dim OutApp As Object

    Dim OutMail As Object



    Set rng = Nothing

    On Error Resume Next

    'Only the visible cells in the selection

    'Set rng = Selection.SpecialCells(xlCellTypeVisible)

    'You can also use a fixed range if you want

    Set rng = ActiveWorkbook.Sheets("NewCriticalSheet").Range("F88").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0



    If rng 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)



    On Error Resume Next

    With OutMail

        .To = ""

        .CC = ""

        .BCC = ""

        .Subject = "This is the Subject line"

        .HTMLBody = RangetoHTML(rng)

        '.Body = Selection.Paste

        .Display   'or use .Send

    End With

    On Error GoTo 0



    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With



    Set OutMail = Nothing

    Set OutApp = Nothing



End Sub

and function module

 Function RangetoHTML(rng As Range)



    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook



    TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"



    'Copy the range and create a new workbook to past the data in

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With



    'Publish the sheet to a htm file

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With



    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.readall

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")



    'Close TempWB

    TempWB.Close savechanges:=False



    'Delete the htm file we used in this function

    Kill TempFile



    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function

I want to know, where can I put other ranges to appear like this?

https://i.imgur.com/87gIE3J.png

Ranges I want to add:

F88 then
N2:O15 then
N17:O22 then
B24:K83

Update: tried the below code as well but nothing showed up at all in the mail body

Set rng = Sheets("NewCriticalSheet").Range("F88, N2:O15, N17:O22, B24:K83").SpecialCells(xlCellTypeVisible)