AW: Verschiedene Tabellenblätter an mehrere Empfänger
23.02.2004 12:54:06
Marcl
Diese beiden Makros verschicken jedes Blatt einer Datei an die in "A100" stehende Maildadresse
Es muss nur das Makro "lop" gestartet werden, das es selbständig auf "Blattversand" zugreift.
Grüße aus dem Norden
Marcl
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 & ".xls"
' Pfadname zum Zwischenspeichern wird vorgegeben
pfadname = "C:\Eigene Dateien\" & Blattname & ".xls"
' 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("A100")
ActiveWorkbook.SendMail Recipients:=mailadresse, Subject:=Blattname
' es wäre schön, wenn in einer Zelle jedes Blattes die Mailadresse stehen könnte (z.B. A100)
' 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 lop()
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