Microsoft Excel

Herbers Excel/VBA-Archiv

Kopie von Sheet per Mail

Betrifft: Kopie von Sheet per Mail von: Pa Mo
Geschrieben am: 09.09.2020 14:00:49

Hallo,


da ich leider so gut wie keine Ahnung von Makros habe, schildere ich Euch erstmal was ich gerne hätte und Ihr könnt schauen ob das überhaupt möglich ist. Sollte darüber hinaus jemand Vorschläge/Lösungen haben, freue ich mich natürlich sehr darüber.


Ich habe eine Datei, die mehrere Reiter beinhaltet, Sheet 1 ist die Hauptliste (als Tabelle formatiert), die anderen enthalten lediglich zulässige Daten die in einzelnen Spalten der Hauptliste über eine Datenprüfung als Liste dann ausgewählt werden können.


Ich würde nun gern Tasten (Makros) einfügen, die mir eine Kopie der Hauptlisten in einer neuen Datei erstellen und diese dann an eine jeweilige Emailadresse versenden.

Prinzipiell habe ich mir diesen Teil auch schon aus verschiedenen Beiträgen hier zusammengebaut/-klaut, es gibt aber noch weitere Punkte, bei denen ich nun nicht weiterkomme.


Hier erstmal der "IST"-Stand des Makros:




Sub Schaltfläche1_Klicken()

Dim Nachricht As Object, OutApp As Object
   Set OutApp = CreateObject("Outlook.Application")
   Dim AWS As String, wksMail As Worksheet
   Set wksMail = Sheets(1)
   AWS = Environ("USERPROFILE") & "\" & wksMail.Name & ".xls"
   
   wksMail.Copy
   With ActiveWorkbook
     .SaveAs AWS
     .Close
   End With
   
   Application.Visible = True
   Set Nachricht = OutApp.CreateItem(0)
   With Nachricht
     .To = "XXX@XXXX.XX"
     .Cc = ""
     .Subject = "TEST " & Date
     .Attachments.Add AWS
     .Body = "Anbei die Liste"
     .Display
   End With
   Set OutApp = Nothing
   Set Nachricht = Nothing
   Kill AWS
 
 End Sub



Jetzt kommen meine Wünsche, die ich nicht umgesetzt bekomme:


1. Die erstellte Datei heißt aktuell immer "Liste" (vermutlich weil der Reiter in der Ursprungsdatei so heißt), ich würde die Datei aber gern mit dem Tagesdatum und dem Namen des Mitarbeiters benennen, also "YYYYMMTT_Schmitz", ist das möglich?


2. Da die Ursprungsdatei Makros enthält, bekomme ich die Meldung:

"Die folgenden Features können in Arbeitsmappen ohne Makros nicht gespeichert werden:

- VB Projekt

Zum Speichern einer Datei mit diesen Features klicken Sie auf 'Nein'. Wählen Sie dann einen Dateityp mit aktivierten Makros in der Liste 'Dateityp' aus.

Klicken Sie auf 'Ja', um die Datei als Arbeitsmappe ohne Makros zu speichern.
"

Bei "Nein" wird der Aufwand größer als ohne Makro (Zwischenspeichern der Datei mit Makro und dann an die Mail anhängen), so bringt es mir halt nix.

Bei "Ja" geht es weiter, allerdings bekomme ich dann beim Öffnen der neuen Datei den folgenden Fehler:

"Das Dateiformat und die Dateierweiterung von 'Liste.xls' passen nicht zueinander. … Möchten Sie die Datei trotzdem öffnen?"

Wähle ich "Ja", funktioniert alles, im Prinzip ist also alles ok, allerdings sind die ganzen Meldungen einfach unschön und nervig, daher die Frage, ob es da nicht eine saubere Lösung für gibt.

Trage ich einfach statt ".xls" ".xlsm" ein, dann wirft mir das Makro einen Laufzeitfehler aus.


3. Bevor ich die jeweiligen Kopien an die Mitarbeiter versende, sortiere ich die Liste und filtere jeweils nach den Mitarbeitern. Die aktuell erstellte Datei beinhaltet beim Öffnen zwar sowohl die Sortierung als auch die Filterung, aber auch die anderen Daten der Tabelle. So kann jeder Mitarbeiter die Filter entfernen und sieht dann trotzdem alles. Ich würde aber gern nur die tatsächlich sichtbaren Daten kopieren, geht das irgendwie?


So, damit wäre ich dann auch schon am Ende und freue mich auf Antworten und ggf. Lösungsvorschläge.


Beste Grüße


Patrick

Betrifft: AW: Kopie von Sheet per Mail
von: peterk
Geschrieben am: 09.09.2020 14:28:12

Hallo

In welcher Spalte stehen Deine Mitarbeiter? Willst Du an alle Mitarbeiter eine Email schicken?

In diesem Beitrag kannst Du nachlesen, wie Du für alle MA (1.Spalte) ein eigense Blatt erzeugst

https://www.herber.de/forum/cgi-bin/callthread.pl?index=1778713

Dieser Code löst dein "Makro" Problem (bzw. die ganzen Meldungen)
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs Filename:=AWS, FileFormat:=56 'xlsx-Datei
        .Close
    End With
    Application.DisplayAlerts = True

Wenn Du mehr Hilfe brauchst, Bitte eine Beispiel Datei

Peter

Betrifft: AW: Kopie von Sheet per Mail
von: Pa Mo
Geschrieben am: 09.09.2020 16:06:35

Hallo Peter,

und erstmal vielen Dank für die schnelle Antwort.

Deine Formel funktioniert direkt, Punkt 2 ist gelöst!

Bezüglich der Mitarbeiter soll jeder eine Liste bekommen, jeweils über eine eigene Makro-Taste.
Wie gesagt, am liebsten nur mit den für Ihn gefilterten Einträgen. Gefiltert wird nach "Mitarbeiter" und "Fälligkeit", wobei ich die Filter per Hand setze, da ggf. ein Mitarbeiter die Termine eines Kollegen übernehmen muss (Urlaub/Krankheit).
Den Eintrag in der Spalte Mitarbeiter will ich aber nicht umstellen, da dass Projekt an sich bei dem entsprechenden Mitarbeiter bleiben soll.
Wenn ich das Makro aus Deinem Link richtig deute, würde es für jeden Eintrag einer bestimmten Spalte (bei mir dann "Mitarbeiter") jeweils eine Tabelle erstellen, die dann nur die Einträge beinhaltet, die dem Mitarbeiter entsprechen. Das würde auf Grund der Übernahme und der Fälligkeit nicht klappen.
Aktuell kopiere ich die gefilterten Daten per Copy/Paste in eine neue Tabelle (dabei kommt die Meldung:
Große Operation
Der Vorgang, den Sie gerade ausführen möchten, wirkt sich auf eine große Anzahl von Zellen aus und kann viel Zeit in Anspruch nehmen. Möchten Sie den Vorgang wirklich fortsetzen?
Hinweis: Dieser Vorgang wird in 60 Sekunden ausgeführt, falls keine Antwort eingeht.
"
An dieser Stelle drücke ich "Abbrechen", weil die Daten im Hintergrund schon komplett kopiert wurden und lediglich die Formatierungen (zumindest teilweise) und das Tabellenlayout nicht übernommen wurde, was in der neuen Datei aber auch nicht relevant ist. Drücke ich "OK" rödelt der PC erstmal ne Minute lang rum, das Ergebnis ist aber scheinbar das gleiche, zumindest sehe ich keinen Unterschied.
Kopiere ich die Tabelle als Werte, dann werden die Kommentare der Zellen nicht übernommen.

Siehst Du hier noch eine mögliche Lösung? Ansonsten bekommen die Mitarbeiter halt die komplette Liste, hierbei läuft ja alles reibungslos.

Gibt es für den neuen Dateinamen keine Lösung, hier dachte ich, wäre das Problem am kleinsten.

Wenn ich morgen dazu komme, erstelle ich eine Musterdatei, die ich dann hochlade, aber ggf. geht es ja auch ohne diese.

Gruß

Patrick

Betrifft: AW: Kopie von Sheet per Mail
von: peterk
Geschrieben am: 09.09.2020 17:11:43

Hallo

Der Code kopiert die aktuell gefilterten Zellen in ein neues Worksheet. Den MA Namen hole ich aus Zelle A2 des neuen Worksheet und generier damit den Filenamen (Datum + Name). Das neue Worksheet wird in ein neues Workbook kopiert und gespeichert, dann danach sofort wieder gelöscht. Auch das neue Worksheet wird wieder gelöscht. Ist zwar getestet, aber Bitte Sicherungskopie anlegen, da ohne Warnung gelöscht wird.

Sub tt()

    Dim MaName As String
    Dim AWS As String
    
    With Worksheets("Tabelle1") 'anpassen
    
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        .AutoFilter.Range.Copy ActiveSheet.Range("A1")
        
        MaName = Format(Date, "YYYYMMDD") & "_"
        MaName = MaName & ActiveSheet.Range("A2")     ' anpassen
            
        AWS = Environ("USERPROFILE") & "\" & MaName & ".xlsx"
    End With
    
    ActiveSheet.Copy
    
    Application.DisplayAlerts = False
    
    With ActiveWorkbook
        .SaveAs Filename:=AWS, FileFormat:=56 'xlsx-Datei
        .Close
    End With
    
    ActiveSheet.Delete
    
    Application.DisplayAlerts = True
    
   'und jetzt per Email versenden
    
End Sub



Betrifft: AW: Kopie von Sheet per Mail
von: Pa Mo
Geschrieben am: 14.09.2020 08:42:06

Hallo Peter,

nochmals vielen Dank für Deine Hilfe und bitte entschuldige die späte Reaktion, ich war Donnerstag und Freitag nicht im Büro und konnte Deine Erweiterung der Formel nicht testen.

Ich habe jetzt alles eingefügt und das Makro läuft auch ohne Fehler durch, allerdings sind in der neuen Datei weiterhin alle Daten und die Filterung ist aufgehoben.
Dadurch wird die Datei auch immer gleich benannt, da in A3 (hier hole ich den Namen her) durch die Aufhebung des Filters immer der gleich Name steht.

Hier mal die aktuelle Formel, vielleicht habe ich ja etwas falsch gemacht.
Sub MAIL()

Dim Nachricht As Object, OutApp As Object
   Set OutApp = CreateObject("Outlook.Application")
Dim MaName As String
Dim AWS As String
    
    With Worksheets("Liste")
    
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        .AutoFilter.Range.Copy ActiveSheet.Range("A1")
        
        MaName = Format(Date, "YYYYMMDD") & "_"
        MaName = MaName & ActiveSheet.Range("E3")
        
        AWS = Environ("USERPROFILE") & "\" & MaName & ".xls"
    End With
    
    ActiveSheet.Copy
    
    Application.DisplayAlerts = False
    
    With ActiveWorkbook
        .SaveAs Filename:=AWS, FileFormat:=56 'xlsx-Datei
        .Close
    End With
    
    ActiveSheet.Delete
    
    Application.DisplayAlerts = True
    
   Application.Visible = True
   Set Nachricht = OutApp.CreateItem(0)
   With Nachricht
     .To = "XXX@XXXX.XX"
     .Cc = ""
     .Subject = "TEST " & Date
     .Attachments.Add AWS
     .Body = "Anbei die Liste"
     .Display
   End With
   Set OutApp = Nothing
   Set Nachricht = Nothing
   Kill AWS

End Sub
Gruß

Patrick

Betrifft: AW: Kopie von Sheet per Mail
von: Pa Mo
Geschrieben am: 14.09.2020 08:44:57

Nachtrag: Ich hole den Namen aus E3, nicht aus A3.

Betrifft: AW: Kopie von Sheet per Mail
von: peterk
Geschrieben am: 14.09.2020 10:17:43

Hallo

Kann ich so nicht nachvollziehen (ich hab aber kein Exceel 2013). Probier folgendes:

Ersetze

.AutoFilter.Range.Copy Destination:=ActiveSheet.Range("A1")

durch

.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("A1")



Betrifft: AW: Kopie von Sheet per Mail
von: Pa Mo
Geschrieben am: 14.09.2020 11:30:19

Perfekt, jetzt läuft es genau wie es soll.

Ich habe noch folgendes ergänzt:
Sheets("Tabelle2").Select
Range("A1").Select
Ansonsten bin ich nach dem Löschen des "temporären Reiters" immer im letzten gelandet, so ist der Ablauf noch etwas runder.

Ich danke Dir vielmals für die super Hilfe.

Beste Grüße

Patrick