Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

2 Tabellenblätter in neue Datei und speichern
#1
Moin Leute,

ich habe folgenden Code zum versenden einer Email aus Excel, dieser klappt sehr gut. Allerdings komm ich bei 2 Dingen nicht weiter. Ich habe mal versucht die möglicherweise relevanten Stellen des Codes raus zu kopieren. Falls nicht ist der ganze Code nochmal unten. 

1. Wie stelle ich ein, dass nicht nur das Aktuelle sondern mehrere Tabellenblätter zusammengeführt werden und in eine neue Datei umgewandelt werden? Der zeit macht er das nur mit dem aktuellem Tabellenblatt

Code:
   'Copy the ActiveSheet to a new workbook
   ActiveSheet.Copy
   Set Destwb = ActiveWorkbook
Hier hatte ich schon z.B. Tabelle2.Copy eingefügt aber geht nicht. 



2. Wo kann ich einstellen, das er alle neu erstellten Dateien, an einen gewissen Ort speichert. 

Code:
'Save the new workbook/Mail it/Delete it
   TempFilePath = Environ$("temp") & "\"
   TempFileName = TextBoxDatei.Text

   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)



Hier mal der komplette Code. 
Code:
Private Sub CommandButton2_Click()

   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim Sourcewb As Workbook
   Dim Destwb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim OutApp As Object
   Dim OutMail As Object

   With Application
       .ScreenUpdating = False
       .EnableEvents = False
   End With

   Set Sourcewb = ActiveWorkbook

   'Copy the ActiveSheet to a new workbook
   ActiveSheet.Copy
   Set Destwb = ActiveWorkbook

   'Determine the Excel version and file extension/format
   With Destwb
       If Val(Application.Version) < 12 Then
           'You use Excel 97-2003
           FileExtStr = ".xls": FileFormatNum = -4143
       Else
           'You use Excel 2007-2016
           Select Case Sourcewb.FileFormat
           Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
           Case 52:
               If .HasVBProject Then
                   FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                   FileExtStr = ".xlsx": FileFormatNum = 51
               End If
           Case 56: FileExtStr = ".xls": FileFormatNum = 56
           Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
           End Select
       End If
   End With

   '    'Change all cells in the worksheet to values if you want
   '    With Destwb.Sheets(1).UsedRange
   '        .Cells.Copy
   '        .Cells.PasteSpecial xlPasteValues
   '        .Cells(1).Select
   '    End With
   '    Application.CutCopyMode = False

   'Save the new workbook/Mail it/Delete it
   TempFilePath = Environ$("temp") & "\"
   TempFileName = TextBoxDatei.Text

   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)

   With Destwb
       .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
       On Error Resume Next
       With OutMail
           .to = ""
           .CC = ""
           .BCC = ""
           .Subject = "Test"
           .Body = "Hallo anbei die Tabelle"
           .Attachments.Add Destwb.FullName
           
           'Anhang hinzufügen
           .Attachments.Add ("U:\Test für Senden.xlsx")
           '.Send or use
           .Display
       End With
       On Error GoTo 0
       .Close savechanges:=False
   End With

   'Delete the file you have send
   Kill TempFilePath & TempFileName & FileExtStr

   Set OutMail = Nothing
   Set OutApp = Nothing

   With Application
       .ScreenUpdating = True
       .EnableEvents = True
   End With
End Sub
Antworten Top
#2
Hallo, :19:

schreibe statt...


Code:
ActiveSheet.Copy

... sowas: :21:


Code:
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2")).Copy

Passe die Tabellenblattnamen an.
________
Servus
Case
[-] Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antworten Top
#3
Hey,

sehr gute Idee.
Allerdings merke ich gerade, dass die Tabellenblätternamen immer anders sind, bzw. geändert werden. Hast du vielleicht ein Idee, wie ich es machen könnte?
In der Userform mit CheckBoxen vielleicht?
Antworten Top
#4
Hallo, :19:

sind es immer die gleichen Sheets die nur umbenannt werden, oder sind es immer andere?

Man könnte mit den CodeNamen der Tabellenblätter arbeiten, dann spielt weder der Name, noch die Position eine Rolle.

Um effektiver helfen zu können, wäre es nicht schlecht eine Beispieldatei mit den zu Grunde liegenden Gegebenheiten zum testen zu haben. :21:
________
Servus
Case
Antworten Top
#5
Sooooo, nach etwas fummeln sollte ich die Datei fertig haben für dich.

Erklärung:

1. in der tabelle einen Filter setzen
2. Auf die Schaltfläche in Tabelle 1 drücken
3. in ein neues Tabellenblatt kopieren
4. Dateinamen in das Feld eintragen
5. Datei per email senden, dann wird Outlook geöffnet und zeigt die Email an mit einer excel Datei die dem letzten Tabellenblatt entspricht.




2 Dinge fehlen mir noch.

Das speichern der Datei die neu erstellt wird und mehrere Tabellenblätter versenden.


P.S.: in meiner großen Tabelle wird noch der Tabellenblattname auch über eine Textbox geändert. Daher geht leider nicht ein Befehlt der z.B. immer Tabelle1 und Tabelle2 verschickt.


Angehängte Dateien
.xlsm   Mappe1.xlsm (Größe: 30,24 KB / Downloads: 4)
Antworten Top
#6
Hallo, :19:

aus deiner Beispieldatei geht nicht hervor welche beiden Tabellenblätter du denn nun versenden möchtest. Wie, wann und warum die umbenannt werden. :21:

Und speichern tust du die Datei doch schon - im Moment in den TEMP-Ordner.
________
Servus
Case
[-] Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antworten Top
#7
Hallo, :19:


Aber du hast jetzt die Makros und weisst denke ich mal eher worum es geht :D
Stell dir also vor ich muss flexibel sein, mal 1 Tabellenblatt und mal sollen 5 Tabellenblätter zusammengeführt werden. 
Finde im Temp Ordner leider nichts, obwohl versteckte Ordner anzeigt werden.
Antworten Top
#8
Hallo, :19:

nun, mit folgendem Befehl in deinem Makro löschst du die Datei ja auch wieder: :21:


Code:
Kill TempFilePath & TempFileName & FileExtStr

Speichere sie einfach mal in einen anderen Pfad und kommentiere die Codezeile mit dem Kill-Befehl aus.

Und wie willst Du die Tabellenblätter, die Du als extra Datei versenden möchtest, auswählen?
________
Servus
Case
[-] Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antworten Top
#9
(20.11.2018, 14:54)Case schrieb: Hallo, :19:

nun, mit folgendem Befehl in deinem Makro löschst du die Datei ja auch wieder: :21:


Code:
Kill TempFilePath & TempFileName & FileExtStr

Speichere sie einfach mal in einen anderen Pfad und kommentiere die Codezeile mit dem Kill-Befehl aus.

Und wie willst Du die Tabellenblätter, die Du als extra Datei versenden möchtest, auswählen?

Code:
  With Destwb
       .SaveAs "U:\TestTabellen" & TempFileName & FileExtStr, FileFormat:=FileFormatNum
       On Error Resume Next
       With OutMail
           .to = ""
           .CC = ""
           .BCC = ""
           .Subject = "Test"
           .Body = "Hallo anbei die Tabelle"
           .Attachments.Add Destwb.FullName
           
           'Anhang hinzufügen
           '.Attachments.Add ("U:\Test für Senden.xlsx")
           '.Send or use
           .Display
       End With
       On Error GoTo 0
       .Close savechanges:=False
   End With

   'Delete the file you have send
   
   'Kill TempFilePath & TempFileName & FileExtStr

   'Set OutMail = Nothing
 '  Set OutApp = Nothing

  ' With Application
  '     .ScreenUpdating = True
  '     .EnableEvents = True
 '  End With
Ich hab den Code jetzt so geändert, aber es tut sich nichts. Es geht alles weiter wie vorher, nichts wird gespeichert. 


Am liebsten eine Auswahlliste, die mir alle aktuellen Tabellenbätter zeigt und dann per hacken setzen, werde die entsprechenden Tabellenblätter zusammengeführt. Sowas in der Art, bin natürlich offen für weitere Vorschläge. Leider ist hinter dem verschicken der Tabellen keine Logik, da die Leute die die Tabellen bekommen fast alle unterschiedlich arbeiten. 


Übrings 1000000000000000000000 dank dir, das du dich mit mir hier hinsetzt.
Antworten Top
#10
Hallo, :19:

das...


Code:
"U:\TestTabellen"

muss eher so sein: :21:


Code:
"U:\TestTabellen\"
________
Servus
Case
[-] Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste