Hallo zusammen,
ich habe folgendes Problem:
Ich möchte eine Vorlage in Tabellenblatt 2 mit Daten aus Tabellenblatt 1 füllen, als PDF exportieren und per Mail verschicken. Das klappt soweit auch wie ich mir das vorstelle.
Allerdings möchte ich das Spalte für Spalte wiederholen und das bekomme ich nicht hin.
Zur Erklärung:
In einer Zeile auf Tabellenblatt 1 stehen Daten die zu einer Person gehören. Diese kopiere ich in die Vorlage meiner PDF und versende sie an eine Mailadresse, die ich ebenfalls aus der Spalte zu dieser Person bekomme.
Wenn deser Schritt abgeschlossen ist, soll allerdings die nächste Zeile automatisch starten, das bedeutet die Daten aus dem ersten Kopiervorgang sollen überschrieben und an eine andere Person versendet werden. Hier komme ich leider nicht weiter.
Bisher arbeite ich hier mit einem aufgezeichneten Makro (kopieren) und einem Pdf per Email Makro, das ich mir so zusammen gesucht habe.
Kann mir hier jemand helfen?
Sub Kopieren()
'
' Kopieren Makro
Range("AA2").Select
Selection.Copy
Sheets("Tabelle2").Select
Range("B7").Select
ActiveSheet.Paste
Sheets("Tabelle1").Select
Range("AB2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle2").Select
Range("C7").Select
ActiveSheet.Paste
Sheets("Tabelle1").Select
Range("AC2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle2").Select
Range("D7").Select
ActiveSheet.Paste
Call PDF_per_EMail
End Sub
Sub PDF_per_EMail()
'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
'** Vorgaben definieren
Set OutlookApp = CreateObject("Outlook.Application")
Set strEmail = OutlookApp.CreateItem(0)
'** PDF erzeugen
Tabelle2.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "/Performance Report.pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
:=False
'** E-Mail versenden
strPDF = ThisWorkbook.Path & "/Performance Report.pdf"
With strEmail
.To = Range("Tabelle1!H2")
.BCC = Range("Tabelle1!I2")
.Subject = "Performance Report" 'Betreffzeile
.body = "Text"
.Attachments.Add strPDF
.Display
'.Send 'Damit wir die E-Mail sofort versendet
Kill strPDF
End With
'** Objektvariablen wieder löschen
Set OutlookApp = Nothing
Set strEmail = Nothing
End Sub
|