Sub SendeEmail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim Range As Range
Dim ClipBoard As MSForms.DataObject
Sheets("Übersicht").Activate
ActiveWindow.DisplayGridlines = False
Set Range = ThisWorkbook.Sheets("Übersicht").Range("A1:P18")
Range.Copy
Set ClipBoard = New MSForms.DataObject
ClipBoard.GetFromClipboard
ActiveWindow.DisplayGridlines = True
Application.ScreenUpdating = True
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "xy@z.com"
.CC = ""
.BCC = ""
.Subject = "Planerfüllung " & Date
.HTMLBody = ClipBoard.GetText(MSForms<u>.DataObjectDataTypeGetText</u>) & .HTMLBody
.Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Set Range = Nothing
Set ClipBoard = Nothing
End Sub