ich habe ein kleines Problem (siehe angehängte Excel 2013 Beispieldatei).
In der Datei sind im Bereich "Ausgangslage" (soll ein Sheet "Reporting" andeuten = Ursprungsdaten) gewisse Daten mittels Formeln zusammengefasst. Die Daten sind nach Spalte A = System sortiert. Ein Makro sollte nun Folgendes erreichen:
1) Sortiert nach den Einträgen in Spalte E = Auth Dev für jeden Namen, der dort enthalten ist, die relevanten Zeilen in ein temporär erstelltes Worksheet kopieren (siehe Beispieldatei alles AUSSER Bereich "Ausgangslage")
2) Den Bereich pro Auth Dev via Mail (outlook Integration vorhanden) an eine im Bereich "Ausgangslage" vorhandene Email versenden und wenn am Ende des temporär erstellten Worksheets angekommen, dieses temporäre Worksheet wieder löschen.
3) Kür wäre nun, wenn ich das noch irgendwie automatisieren könnte. Macht aber wahrscheinlich wenig Sinn, da hierzu die Datei geöffnet sein müßte, oder nicht ?
Geht das überhaupt oder habe ich zuviel Endorphine zwischen meinen Synapsen
Ich bin für jede Hilfe dankbar auch für die, die mir sagt, dass es nicht geht.
Besten Dank vorab, auch ... dass Ihr es Euch überhaupt durchgelesen habt.
LG
Stefan
P.S.: Und sorry dafür, wenn ich schon wieder im falschen Bereich lande.
erst mal als Ansatz zum email-Versand: Nutze die Suche, Stichworte sind Tabelle email. Dort findest Du unter anderem 3 Beiträge zum Thema, ich war da zuweilen auch involviert.
Einen Makro - Ansatz für das "Filtern" und Kopieren der Daten bekommst Du, wenn Du die entsprechende Aktion aufzeichnest. Für den email-Versand ist eine Kopie der Daten auf ein temporäres Blatt vorzusehen. Dieses Blatt wird dann gesondert gespeichert und kann dann als Anhang versendet werden.
Alternativ könnte man den Body einer Nachricht auch direkt befüllen.
Schaue Dir das erst mal alles an und melde Dich noch mal, dann sehen wir morgen weiter.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
28.09.2015, 08:45 (Dieser Beitrag wurde zuletzt bearbeitet: 28.09.2015, 08:46 von steff97.
Bearbeitungsgrund: Datei fehlt als Anhang
)
Hallo schauan,
besten Dank für Deine Unterstützung und sorry für die späte Antwort.
Ich hab eine (hoffentlich) "bessere" Beispieldatei im Upload. Ich bin ein Makroanfänger und bekomme immer wieder den Fehler 1004 und blicke es nicht.
Zeile 13 (in Reporting) ist Kopfzeile, Spalte 5 ist die Filterspalte.
Hier ist der Code(Ich hab die vom Debugger anmonierte Zeile rot markiert):
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Begriff As String, gefunden As Variant, firstAddress As Variant, _
Zeile As Long
Begriff = InputBox("Verantwortliche Person ? (Bitte Suchstring mit einem * beginnen und abschließen):", "Suchbegriff")
If Begriff = "" Then Exit Sub
With Sheets("Reporting").Cells
Set gefunden = .Find(Begriff, LookIn:=xlValues)
If Not gefunden Is Nothing Then
firstAddress = gefunden.Address
Worksheets("Dataexport").Rows("1:3000").Delete
Sheets("Reporting").Rows(13).Copy Destination:=Worksheets("Dataexport").Rows(1)
Worksheets("Reporting").Activate
ActiveSheet.Range("$A$13:$AY$3000").AutoFilter Field:=5, Criteria1:= _
Begriff, Operator:=xlAnd
Do
Sheets("Reporting").Rows(1).Copy Destination:=Worksheets("Dataexport").Rows(2)
Zeile = gefunden.Row
Rows(Zeile).Copy Sheets("Dataexport").Cells(Rows.Count, 1).End(x1Up).Offset(2, 0).PasteSpecial
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Set gefunden = .FindNext(gefunden)
Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
End If
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Folgendes soll gemacht werden:
- Nach der Messagebox wird im Sheet Reporting nach Werten gesucht, die den Suchbegriff erfüllen und nach diesem gefiltert => funktioniert, Filter wird gesetzt
- Diese Werte sollen in kompletten Zeilen iterativ kopiert werden in einer Schleife => Zeile wird kopiert und beim Einfügen bekomme ich den Fehler 1004 "Anwendungs- oder objektdefinierter Fehler" und das hat mal mit diesem Code funktioniert
Zukunftsmusik/Wünsche
- Wenn der Fehler mal bereinigt ist, dann möchte ich diese kopierten Daten an die jeweilige Emailadresse schicken, hinter die der jeweilige Bearbeiter steckt.
- Auch hätte ich gerne, dass zur Datenkopie ein temporäres Tabellenblatt erstellt wird, das immer gleich heisst. Dazu müsste verprobt werden, ob es schon da ist und wenn es schon da ist, sollte es gelöscht werden, bevor es neu erstellt und mit Daten befüllt wird.
Kannst Du/ Könnt Ihr helfen ?
Ich bin für jede Hilfe mehr als dankbar.
LG
28.09.2015, 08:47 (Dieser Beitrag wurde zuletzt bearbeitet: 28.09.2015, 16:25 von Rabe.
Bearbeitungsgrund: nicht immer den gesamten Beitrag zitieren!
)
(28.09.2015, 08:45)steff97 schrieb: Kannst Du/ Könnt Ihr helfen ?
Ich bin für jede Hilfe mehr als dankbar.
wenn ich alles richtig verstanden habe, dann würde ich in Deinem Fall den Spezialfilter nutzen.
Das sind ein Paar Zeilen Code (ohne Fehlerbehandlung) und die Ausführung ist sehr schnell.
In der eingestellten Datei kannst Du sehen, wie so etwas funktioniert.
Das neu anlegen von Tabellen und versenden per Mail kann dann darauf aufgebaut werden und sollte
keine Probleme darstellen.
ganz lieben Dank für Deinen Code. Er läuft bei der Beispieldatei prima. Nur bei der Originaldatei produziert er Fehler (er läuft durch, löscht aber in Reporting Zellbereich A1:Z14 und trägt bei Dataexport nichts ein; beim ersten Durchlauf brachte er auch die Fehlermeldung, dass die Operation mit verbundenen Zellbereichen nicht durchgeführt werden konnte). Ich habe daher die Beispieldatei auf die Originaldatei angepasst (von der Breite her) und nochmal hier hinein geladen. Einziger Unterschied ist nun, dass nicht nur 10 Zeilen in der Originaldatei sind sondern über 300. Ich habe versucht den Bereich entsprechend in der Breite zu erweitern. Hier mein angepasster Code von Dir:
Sub daten_Suche_und_kopie()
Dim Begriff As String
Dim ZeileReporing As Long
Dim ZeileDataex As Long
Begriff = InputBox("Bitte verantwortlichen Administrator eintragen ? (Bitte Suchstring mit einem * beginnen und abschließen):", "Suchbegriff")
If Begriff = "" Then Exit Sub
With Sheets("Reporting")
ZeileReporing = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Sheets("Dataexport")
ZeileDataex = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Range("A3:AZ" & ZeileDataex).Clear
.Range("E1") = Sheets("Reporting").Range("E13").Value
.Range("E2") = Begriff
Sheets("Reporting").Range("A13:AZ" & ZeileReporing).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("E1:E2"), CopyToRange:=.Range("A4:AZ"), Unique:=False
.Range("E1:E2").Clear
End With
End Sub
Fragen:
- Ich habe die gelben Werte erweitert, wo ist mein Fehler ?
Nochmal besten Dank für Deine Hilfe. Vielleicht hast Du ja auch einen Code, wie man dann diese Datensätze in Dataexport an die hinterlegte Mailadresse schickt und das Dataexport wieder löscht.
LG
