VBA bestimme Zellen per Mail versenden...

Sub q()
Dim oOL As Object
Dim oOLMsg As Object
Dim oOLRecip As Object
Dim oOLBody As Object
Dim sAddress As String
Dim rng As Range
Set rng = ActiveWindow.RangeSelection
sAddress = Range("D1").Value
Set oOL = CreateObject("Outlook.Application")
Set oOLMsg = oOL.CreateItem(0)
With oOLMsg
Set oOLRecip = .Recipients.Add(sAddress)
.Subject = "Dies ist ein Outlook-Test"
.Body = (rng)
.Importance = 1
.Send
End With
oOLRecip.Resolve
Set oOLRecip = Nothing
Set oOLMsg = Nothing
Set oOL = Nothing
End Sub