Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1800to1804
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten Tabelle filtern / Export / Versand

Daten Tabelle filtern / Export / Versand
16.12.2020 22:05:31
Roman
Guten Abend allerseits
Die Lage bringt mich zum verzweifeln. Hab mich mit Tutorials etwas in die Materie eingearbeitet und das Meiste funktioniert. Nur das Neuste nicht:
Ich habe eine grosse Datentabelle. Daraus muss ich nun täglich eine Zusammenstellung per Mail versenden, die von drei Faktoren abhängig ist.
Die Datei hat drei Blätter, ich nenne Sie mal: AAA (Filteroptionen in Zelle C17-Text, C18-Datum und D19-Wert), BBB (Datenquelle A:BF) und XXX (Auffangtabelle für den Export).
Die Werte in BBB sind fast ausschliesslich mit Bezügen und SVERWEIS aus einer weiteren Mappe importiert.
Aus einem Youtube-Video (0069. Excel-VBA: Daten filtern, exportieren und versenden) habe ich _ mir folgenden Code genommen und angepasst (hier mit einigen Platzhaltern dargestellt):

Sub EXCELfiltern1()
tbl_XXX.UsedRange.Clear
With tbl_BBB.ListObject
.Range("A1:BF12030").AutoFilter Field:=3, _
Criterial:=Worksheets("AAA").Range("C17")
.Range("A1:BF12030").AutoFilter Field:=46, _
Criterial:=Worksheets("AAA").Range("C18")
.Range("A1:BF12030").AutoFilter Field:=32, _
Criterial:=Worksheets("AAA").Range("D19")
.UsedRange.Copy Destination:=tbl_XXX.Range("a1")
.AutoFilterMode = False
Call ExportXLSX
End With
End Sub


Sub ExportXLSX()
Application.DisplayAlerts = False
'Kopiert die Tabelle in eine neue, leere Mappe
tbl_XXX.Copy
ActiveWorkbook.SaveAs Filename:="MUSTER_Export.xlsx" '
ActiveWorkbook.Close 'savechanges:=true
Application.DisplayAlerts = True
Call XLSXVersand
End Sub


Sub XLSXVersand()
Dim Outlook As Object
Dim OutlookMailItem As Object
Dim myAttachments As Object
Set OutlookApp = CreateObject("Outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = "MUSTER"
.Subject = "MUSTER"
.Body = "Im Anhang finden Sie die neusten Meldungen."
myAttachments.Add "MUSTER_Export.xlsx" ' Der Versand funktioniert bisher, sofern die Datei _
erzeugt werden kann
'.send
.Display
End With
Set OutlookApp = Nothing
Set OutlookMailItem = Nothing
End Sub

Mein Hauptproblem: bereits bei tbl_XXX.UsedRange.Clear oder weiter unten tbl_XXX.Copy erhalte ich immer den Laufzeitfehler '424' Objekt Erforderlich.
Was kann ich tun?
Danke im Voraus für die Tipps

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 22:14:06
ralf_b
tbl_XXX.Copy
was ist tbl_XXX ? Ist das ein Bereichsname oder der Name des Arbeitsblattes?
wenn Blattname dann besser so Worksheets("Tbl_XXX").UsedRange.clear
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 22:19:07
Roman
Der Ort wo das Ganze hinkopiert werden soll (also das neue Blatt) hab ich analog zum Video XXX genannt (Im Youtube-Video hiess dieses Blatt Export und die kopierte Zeile lautete tbl_Export.UsedRange.Clear etc
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 22:32:29
ralf_b
naja es gibt den Codenamen und den Blattnamen.
die beiden Bezeichnungen ,die man im Projektexplorer sieht.
der codename steht vor den Klammern und den kann man so benutzen wie du es versuchst. den Blattnamen nur über die Worksheetsauflistung.
der Fehler 9 tritt auf wenn du ein Blatt ansprichst das in der Mappe nicht existiert.
Anzeige
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 22:58:43
Roman
Okee.... Danke schon Mal! Hab nun das Blatt neu gemacht als Tabelle3 und mit deinem Hinweis und nun funktioniert schon einiges mehr... jedoch tut er sich noch mit meiner Filteridee schwer. Wie kann ich diese drei Bedingungen schöner formulieren im ersten Abschnitt?
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 22:26:27
Roman
Mit der Variante Worksheets("Tbl_XXX"). und Worksheets("XXX"). erhalte ich nun den Laufteizfehler '9' Index ausserhalb des gültigen Bereichs...
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 22:58:58
Werner
Hallo,
weshalb das ganze auf 3 Prozeduren verteilen?
Sub EXCELfiltern1()
Dim Outlook As Object, OutlookMailItem As Object, myAttachments As Object
Worksheets("XXX").UsedRange.Clear
With Worksheets("BBB")
.Range("A1:BF12030").AutoFilter Field:=3, Criterial:=Worksheets("AAA").Range("C17")
.Range("A1:BF12030").AutoFilter Field:=46, Criterial:=Worksheets("AAA").Range("C18")
.Range("A1:BF12030").AutoFilter Field:=32, Criterial:=Worksheets("AAA").Range("D19")
.AutoFilter.Range.Copy Worksheets("XXX").Range("A1")
.AutoFilterMode = False
End With
Worksheets("XXX").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\MUSTER_Export.xlsx"
ActiveWorkbook.Close
Set OutlookApp = CreateObject("Outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = "MUSTER"
.Subject = "MUSTER"
.Body = "Im Anhang finden Sie die neusten Meldungen."
myAttachments.Add ThisWorkbook.Path & "\MUSTER_Export.xlsx"
.Display
End With
Set OutlookApp = Nothing: Set OutlookMailItem = Nothing
End Sub
Die Blattnamen mußt du an deine tatsächlichen Gegebenheiten anpassen.
Laufzeitfehler 9 bedeutet, dass es in deiner Datei kein Blatt mit dem Namen "XXX" gibt.
Gruß Werner
Anzeige
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 23:19:21
Roman
Danke Werner, für die Vereinfachung. Den Filter schluckt er mir aber immer noch nicht: immer wieder der 1004er...
AW: Daten Tabelle filtern / Export / Versand
16.12.2020 23:23:52
Werner
Hallo,
und wer soll jetzt damit was anfangen?
Blattschutz drauf?
Lad die Datei hoch, Hellsehen kann hier niemand.
Gruß Werner
AW: Daten Tabelle filtern / Export / Versand
17.12.2020 10:11:56
ralf_b
Moin,
Schon witzig das Jemand Hilfe bei VBA haben will und dann eine Datei so ganz ohne VBA hochlädt.
So gesehen hast du tatsächlich zuviel rausgelöscht.
Scheint fast so als ob du viel dafür tust keine Hilfe zu bekommen.
Gruß
RB
Anzeige
AW: Daten Tabelle filtern / Export / Versand
17.12.2020 12:51:48
Werner
Hallo,
das ist so einigse verquer. Du filterst die falschen Spalten.
Spalte C = Field:=3 stimmt
Spalte AF = Field:=32 stimmt nicht, diese Daten stehen in Spalte AM = Field:=39
Spalte AT = Field:=46 stimmt nicht, diese Daten stehen in Spalte BE = Field:=58
Teste mal:
Sub EXCELfiltern1()
Dim Outlook As Object, OutlookMailItem As Object
Dim myAttachments As Object, sh As Shape
With Worksheets("Selektion")
If .Range("C17")  "" And .Range("C18")  "" And .Range("D19")  "" Then
If IsDate(.Range("C18")) Then
Worksheets("Export").UsedRange.Clear
With Worksheets("Resultatetabelle")
strDatum = Format(Worksheets("Selektion").Range("C18"), "MM/DD/YYYY")
.ListObjects("Resultatesammlung").Range.AutoFilter Field:=3, Criteria1:= _
Worksheets("Selektion").Range("C17").Value
.ListObjects("Resultatesammlung").Range.AutoFilter Field:=39, Criteria1:= _
Worksheets("Selektion").Range("D19").Value
.ListObjects("Resultatesammlung").Range.AutoFilter Field:=58, _
Operator:=xlFilterValues, Criteria2:=Array(2, Replace(strDatum, ".", "/"))
If .ListObjects("Resultatesammlung").AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
.ListObjects("Resultatesammlung").Range.SpecialCells(xlCellTypeVisible) _
.Copy Worksheets("Export").Range("A1")
.ListObjects("Resultatesammlung").Range.AutoFilter
Else
MsgBox "Zu den Kriterien gibt es kein Filterergebnis"
.ListObjects("Resultatesammlung").Range.AutoFilter
Exit Sub
End If
End With
With Worksheets("Export")
If .Shapes.Count > 0 Then
For Each sh In .Shapes
sh.Delete
Next sh
End If
.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\MUSTER_Export.xlsx"
ActiveWorkbook.Close False
End With
Set OutlookApp = CreateObject("Outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = "MUSTER"
.Subject = "MUSTER"
.Body = "Im Anhang finden Sie die neusten Meldungen."
myAttachments.Add ThisWorkbook.Path & "\MUSTER_Export.xlsx"
.Display
End With
Else
MsgBox "Fehler: Kein gültiges Datum in Zelle C18"
End If
Else
MsgBox "Fehler: Es sind nicht alle Kriteriumsfelder befüllt."
End If
End With
Set OutlookApp = Nothing: Set OutlookMailItem = Nothing
End Sub
Die Export-Datei wird im gleichen Verzeichnis abgespeichert, in dem sich auch die Datei mit dem Marko befindet.
Ich habe noch ein paar Prüfungen mit eingebaut:
1. Prüfung, dass auch alle drei Filterkriterien im Blatt "Selektion" erfasst wurden
2. Prüfung auf ein gültiges Datum im Blatt "Selektion" Zelle C18
3. Prüfung, ob mit den eingegebenen Kriterien auch ein Filterergebnis vorhanden ist.
Das Tabellenblatt, das für den Export kopiert wird mußt du in "Export" umbenennen.
Gruß Werner
Anzeige

119 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige