Sub CopyRangeMail()
Dim sSig As String, sSubject As String, sTo As String, sCC As String, sBcc As String
Dim rng As Excel.Range
Dim olAPP As Outlook.Application
Dim olMail As Outlook.MailItem
Dim olInspec As Object
Set olAPP = GetObject(Class:="Outlook.Application")
Set olMail = olAPP.CreateItem(olMailitem)
Set rng = ThisWorkbook.Worksheets(1).Range("A5:E7")
rng.CopyPicture xlScreen, xlBitmap
Set olInspec = olMail.GetInspector.WordEditor
olInspec.Range(0, 0).Paste
sTo = "toReceipient@outlook.local"
sCC = "CarbonCopy@outlook.local"
sBcc = "BlindCarbonCopy@outlook.local"
sSubject = "Betreffzeile"
With olMail
sSig = .HTMLBody
.To = sTo
.CC = sCC
.BCC = sBcc
.Subject = sSubject
.Display
End With
Set rng = Nothing
Set olInspec = Nothing
Set olMail = Nothing
Set olAPP = Nothing
End Sub