Mehrere Tabellenblätter zusammenfassen und per Mail schicken

[elamigo]

Hey Leute,

ich fasse mich in 2 Posts.

Ich habe eine Datei, in der ich eine Userform eingefügt habe. Mit dieser Userform werden Daten gefiltert, anschließend werden die gefilterten Daten auf ein neues Tabellenblatt kopiert, dieses wird benannt, dann wird der Name der Datei eingegeben und das aktuelle Tabellenblatt wird als gesonderte Datei per mail verschickt.

Mein Problem ist, das ist immer nur das aktuelle Tabellenblatt geschickt wird. Mein Traum wäre eine Auswahlliste aller Tabellenblätter in der Userform, wo ich dann aussuchen kann, welches ich, in einer gesonderten Datei, verschicken möchte

Der Code dafür ist unten beigefügt. Falls ihr es lieber sehen wollt, ist auch eine Datei dabei. Ich hoffe es geht alles, musste sehr viel aus der Tabelle löschen. 

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
   
   'ThisWorkbook.Worksheets(Array("Tabelle14", "Diagramm2")).Copy

   '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 "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
End Sub

danke schon mal für die Mühe   :19:

[00202]

Hallo, :19:

probiere es mal so der Spur nach: :21:
[attachment=20906]

Jedesmal wenn Du die UserForm startest oder in der Form auf "Kopieren" klickst wird das neue Tabellenblatt in der ListBox angezeigt. Dort kannst Du mehrere auswählen und dann versenden. Im Moment wird die Datei unter "C:\Temp\" gespeichert - also anpassen.

[elamigo]

Hey, wenn ich deine Code also: 

Code:

Private Sub UserForm_Activate()
   Dim lngTMP As Long
   Dim strSheets() As String
   ReDim strSheets(1 To Worksheets.Count)
   For lngTMP = 1 To Sheets.Count
       strSheets(lngTMP) = Worksheets(lngTMP).Name
   Next
   ListBox1.List = strSheets
End Sub

in meine "richtige" Tabelle überführe, dann kann ich immer nur eine Tabelle in der Liste anklicken. :( ansonsten klappt das schon super!

Edit: 

Code:

ListBox1.MultiSelect = fmMultiSelectMulti

einfügen dann klappt es !

[00202]

Hallo, :19:

nimm noch folgende Codezeile mit auf: :21:

Code:

ListBox1.MultiSelect = 1

Oder stelle es in den Eigenschaften der ListBox ein.

[elamigo]

klappt alles perfekt danke dir! Du hast echt genau das geschafft was ich brauchte :)

Kleine Zusatzaufgabe?   
Wie aktualisiere ich die ListBox? Entweder per Knopf druck auf eine neue Schaltfläche oder in die Schaltfläche "übernehmen" implementieren?


LG

[00202]

Hallo, :19:

genauso wie im Button "Kopieren". :21:

[elamigo]

Das verstehe ich jetzt nicht :D
Wenn ich jetzt die Tabellen umbennen muss ich erst die Userform schließen und dann wieder öffnen. Gibt es keine anderen Möglichkeit? Ich habe etwas gelesen darüber das man es über die Zeit regeln kann oder über die Bewegung der Maus, allerdings habe ich nichts passenden gefunden. 
Ansonsten mache ich ein neues Thema auf 

[00202]

Hallo, :19:

im Code vom CommandButton "Kopieren" habe ich am Ende zwei Codezeilen hinzugefügt - die sehe ich ohne Brille (sonst brauche ich eine). Die Zeile mit Call... kopierst Du einfach ans Ende des CommandButton "Übernehmen" - dazu braucht es keine neues Thema. :17:

[elamigo]

Wald vor läuter Bäumen....


danke! klappt!

ALLES KLAPPT!

[00202]

Hallo, :19:

dafür ist die Codezeile...

Code:

Application.Goto Tabelle1.Range("A1"), True

... verantwortlich. :21:

Die einfach auskommentieren bzw. rausnehmen.