Werte + Format kopieren, speichern + sen
08.05.2020 09:59:05
Mak
Gerne möchte ich für einen Monatsreport insgesamt 3 Tabellenblätter mit Pivot Tabellen Kopieren und als Werte mit den Formaten in eine neue Arbeitsmappe speichern.
Zudem sollte das makro die Neue Arbeitsmappe abspeichern und als Email versenden.
Mein Code kann bis jetzt zwar das aktive Tabellenblatt kopieren abspeichern und per email versenden. Jedoch sollten, wie erwähnt drei spezifische Arbeitsblätter, nämlich ("DA-Report", "Fach-Report", "Art-Report") in die neue Mappe kopiert werden, und dabei einen PasteSpecial für Werte und Formate machen.
Hier mein aktueller Stand:
Sub Datapull_via_Outlook_Senden()
Dim Nachricht As Object, OutApp As Object
Dim SavePath As String
Dim AWS As String
SavePath = "D:\Automaten\Verkauf\Gesendet"
Set OutApp = CreateObject("Outlook.Application")
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und dem Namen in A1
ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & " " & ActiveSheet.Range("A1")
'Aktive Arbeitsmappe wird als mail gesendet
AWS = ActiveWorkbook.FullName
'InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "max.mustermann@Musterfirma.de"
.Subject = "Testmeldung von Excel2000 " & Date & Time
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
'.body = "Das ist ein Test" & vbCrLf & "Bitte ignorieren"
'Hier wird die HTML Mail erstellt
.HTMLBody = "Hallo, anbei sende ich die Verkaufszahlen der Automaten des letzten Monats. _
_
_
Gruß"
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
'Hier könnte die Datei wieder gelöscht werden
'Kill AWS
End With
OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub
Danke in Voraus