Hallo zusammen,

ich möchte mehrere Tabellenblätter an unterschiedliche Mail-Adressen versenden. Ich bin absoluter VBA-Neuling, habe auf einer Website einen entsprechenden Code gefunden, komme damit aber nicht weiter. Auf der Website ist vermerkt, dass man lediglich das Makro "lop" (bei mir heißt es "neu") starten soll, dann würde alles funktionieren. Bei mir kommt allerdings der Laufzeitfehler 1004.

Ist es zudem möglich, noch einen E-Mail-Text vorzugeben, der durch die Standard-Signatur in Outlook ergänzt wird?

Könnt ihr mir bitte helfen? Vielen Dank vorab!

Sub Blattversand()
' Fehlermeldungen werden ausgeschaltet. Dateien werden gespeichert, auch wenn schon eine mit
' diesem Namen existiert. Vorherige Datei wird überschrieben.
Application.DisplayAlerts = False
    Application.Volatile
' Blattname wird ausgelesen
    Blattname = ActiveSheet.Name
    BlattName2 = Blattname & ".xlsx"
' Pfadname zum Zwischenspeichern wird vorgegeben
pfadname = "C:\Users\gccai\EIGENE DATEIEN\GCCAI\Arzt Apothekenabverkaufsdaten Temp\" & Blattname & ".xlsx"
' neue Arbeitsmappe anlegen mit dem Blattnamen zwischenspeichern
    Set neuemappe = Workbooks.Add
    With neuemappe
        .SaveAs Filename:=pfadname
    End With
' zur =Originalmappe wechseln und die Meldung in die neu erzeugte Mappe kopieren, vor Tabelle 1
    ThisWorkbook.Activate
    Sheets(Blattname).Copy Before:=Workbooks(BlattName2).Sheets(1)
' Leertabellen löschen
    tabzahl = Sheets.Count
    stammwert = 1
    For tz = stammwert To tabzahl
            If tabzahl = stammwert Then Exit For
                If tz = tabzahl Then Exit For
                tabname = "Tabelle" & tz
                Sheets(Array(tabname)).Select
                ActiveWindow.SelectedSheets.Delete
    Next
' Datei mailen
mailadresse = Range("F1")
    ActiveWorkbook.SendMail Recipients:=mailadresse, Subject:=Blattname
' es wäre schön, wenn in einer Zelle jedes Blattes die Mailadresse stehen könnte (z.B. F1)
' Die erzeugte Arbeitsmappe nach dem Versand per Mail schliessen und anschließend aus dem Verzeichnis löschen
    ActiveWindow.Close
    On Error Resume Next
    Kill (pfadname)
End Sub

Sub Neu()
' loopFunktion wählt nacheinander jedes Blatt in der Datei aus und startet dann
' obriges Makro zum Mailen
    Dim Sh As Worksheet
    For Each Sh In Worksheets
        Sh.Activate
Call Blattversand
    Next Sh
End Sub

Beste Grüße

Carsten