email > cc ergänzen

Sub Blatt_senden2()
Dim Empfaenger As String
Dim wsQuelle As Worksheet, wsTemp As Worksheet
Empfaenger = [L13]
If Range("O10").Value = "TEST" Then
Set wsQuelle = Sheets("Abfrage")
Workbooks.Add
Application.DisplayAlerts = False
'Überflüssige Blätter der neuen Mappe löschen :
If Sheets.Count > 1 Then
For Each wsTemp In Sheets
If wsTemp.Index > 1 Then wsTemp.Delete
Next
End If
wsQuelle.Cells.Copy
ActiveSheet.Name = wsQuelle.Name
With ActiveSheet.Cells
.PasteSpecial Paste:=xlValues   'Werte einfügen
.PasteSpecial Paste:=xlFormats  'Formate einfügen
End With
ActiveWorkbook.SendMail Empfaenger, "Grenz-Zahl erreicht !"
ActiveWindow.Close
Application.DisplayAlerts = True
End If
End Sub

Sub OL_Senden()
Dim olapp As Object
Dim objMail As Object
Dim Empfaenger As String
Empfaenger = [L13]
If Range("O10").Value = "TEST" Then
Set olapp = CreateObject("Outlook.Application")
Set objMail = olapp.CreateItem(olMailItem)
With objMail
'.cc = "xxx@yyy.com"
'.bcc = "zzz.uuu@ccc.de"
To = Empfaenger
.Subject = "Grenz-Zahl erreich"
.Subject = Environ("Username") & " schickt Info:  Grenz-Zahl erreicht!"
'.Body = "hier dein Text, der als email-Text erscheinen soll"
.Body = Worksheets("Abfrage").Range("I10").Value
'.Display 'zeigt die Mail nur an - du musst auf Senden klicken
.Send 'legt die Mail gleich in den Postausgang
End With
End If
End Sub