Makro:Sortieren,Filtern,Email

Question

Hallo zusammen,

ich bin leider ein absoluter VBA-Neuling, der sich anfangs mehr zugetraut hat und nun sich aber die Haare am ausraufen ist.
Und zwar stehe ich vor folgender Aufgabe:

Ich habe eine vorgegebene Tabelle, 5 Spalten (A=Workcenter, B=Bestellmenge, C=Einheit, D=Artikelnummer,E=Beschreibung)

Nun soll der Mitarbeiter NUR die Bestellmenge eingeben können, in Form von Zahlen <1. Hat er dies getan, soll er eine Schaltfläche anklicken, welche mit einem Makro verknüpft ist.
Und genau hier ist mein Problem.

Dieses Makro soll
1. Ein neues Tabellenblatt öffnen (nennen wir es "komprimierte Bestelliste"
2.Die Tabelle nach der Bestellmenge filter und dann nur die Zeilen(mit allen 5 Spalten) in "komprimierte Bestellliste" ausgeben, wo ein Wert <1 eingegeben wurde.
3.Dieses Tabellenblatt "komprimierte Bestellliste" als email an eine feste emailadresse versenden
4. Danach alles wieder zurück setzen.

Ich hoffe es ist einigermaßen deutlich geworden was ich meine.

Nun hab ich schon recherchiert und bin auf folgende makros gestoßen:

Sub Sortier2()
Dim Kriterium As String
Kriterium = InputBox("Bitte den zu Filternden Begriff eingeben", "Eingabefenster")
Range("A3").Select
ActiveWindow.ScrollRow = 810
Range("A3:K834").Select
Selection.Sort Key1:=Range("I4"), Order1:=xlAscending, Key2:=Range("B4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A3").Select
Selection.AutoFilter Field:=9, Criteria1:=Kriterium, Operator:=xlAnd
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True
End Sub

--> dieses druckt allerdings und setzt mir die tabelle nicht zurück

Sub email()
Application.Dialogs(xlDialogSendMail).Show "mymail"
End Sub

--> dieses klappt gut, aber ist halt nur die email und ich hätte das gerne in einem schritt


Falls jemand eine Idee hat, wäre ich unendlich dankbar.

Also in diesem Sinne, vielen vielen Dank im Voraus!!

Liebe Grüße,

eine verzweifelnde Praktikantin

Answer 1

Hallo verzweifelnde Praktikantin!

Nachfolgend mal ein Makro, dass alles das, was Du geschrieben hast, machen sollte.
Mit dem Makro wird die Spalte B (Bestellmenge) ausgewertete. Alle Artikel, deren Menge kleiner der Menge 1 ist, werden in einem separaten Tabellenblatt erfasst. Dieses Tabellenblatt wird gedruckt (wenn nicht gedruckt werden soll, Zeile löschen oder auskommentieren, siehe Kommentar im Makro) und in eine neue Datei kopiert. Diese neue Datei wird dann an eine Outlook-Mail angehängt und die Mail wird dann angezeigt (Mail kann auch gleich versandt werden, siehe dazu Kommentar im Makro). Danach wird das neu erstellte Blatt wieder gelöscht und die neu erstellte Datei, die an die Mail angehängt wurde, wird wieder gelöscht.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Const strSavePath = "H:\"
Const strMailEmpfänger = "Deine E-Mail@web.de"
Const strBetreffzeile = "Komprimierte Bestelliste"
Const strNachricht = "Anbei die komprimierte Bestellliste"

Sub Auswerten()
Dim intSheets As Integer
Dim lngFirstRow As Long
Dim lngRow As Long
Dim lngZähler As Long
Dim lngFirstFreeRow As Long
Dim wksNewSheet As Worksheet
Dim objNachricht As Object
Dim objOutApp As Object
Dim strSavePath As String
Dim strMailDat As String

On Error GoTo ERRORHANDLER

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

'Auswertblatt löschen falls noch vorhanden
For intSheets = 1 To Sheets.Count
Application.DisplayAlerts = False
If Sheets(intSheets).Name = "komprimierte Bestelliste" Then
Sheets(intSheets).Delete
Exit For
End If
Application.DisplayAlerts = True
Next

'Neues Blatt erzeugen
Set wksNewSheet = Worksheets.Add

wksNewSheet.Name = "komprimierte Bestelliste"

'Überschriften in neues Blatt kopieren
Sheets("Tabelle1").Range("A1:E1").Copy wksNewSheet.Range("A1")

'Bestellmengen auswerten und Datensatz kopieren, wenn Bestellmenge < 1
For lngRow = 2 To Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("Tabelle1").Cells(lngRow, 2) < 1 Then
lngZähler = lngZähler + 1
lngFirstFreeRow = wksNewSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("Tabelle1").Rows(lngRow).Copy
wksNewSheet.Cells(lngFirstFreeRow, 1).PasteSpecial Paste:=xlPasteValues
End If
Next

'Wenn keine Daten in neues Blatt kopiert wurden, Prozedur beenden
If lngZähler = 0 Then GoTo ERRORHANDLER

'Blatt drucken, wenn gewünscht. Wenn nicht, Zeile löschen oder auskommentieren _
durch setzen des Hochkommas ( ' ) vor der Zeile
Sheets("komprimierte Bestelliste").PrintOut From:=1, To:=1, _
Copies:=1, Collate:=True

'Neu erzeugtes Blatt in neue Datei kopieren
Sheets("komprimierte Bestelliste").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs strSavePath & "komprimierte Bestelliste"
Application.DisplayAlerts = True
strMailDat = ActiveWorkbook.FullName
ActiveWorkbook.Close

'E-Mailversandt
Set objOutApp = CreateObject("Outlook.Application")
Set objNachricht = objOutApp.CreateItem(0)
With objNachricht
.To = strMailEmpfänger
.Subject = strBetreffzeile
.Attachments.Add strMailDat
.HTMLBody = strNachricht
'Mit "Display" würde die Mail angezeigt, aber nicht versandt
.Display
'Mit "Send" würde die Mail sofort versandt ohne sie anzuzeigen
'Mail.Send
End With

'Soll Outlook wieder geschlossen werden, dann das Hochkomma _
( ' ) vor "objOutApp.Quit" entfernen
'objOutApp.Quit


ERRORHANDLER:
Application.DisplayAlerts = False
Sheets("komprimierte Bestelliste").Delete

On Error Resume Next
Kill strMailDat
On Error GoTo 0

Set wksNewSheet = Nothing
Set objOutApp = Nothing
Set objNachricht = Nothing

With Application
.ScreenUpdating = False
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With
End Sub

Du musst in dem Makro noch in den Zeilen

Const strSavePath = "H:\"
Const strMailEmpfänger = "Deine E-Mail@web.de"
Const strBetreffzeile = "Komprimierte Bestelliste"
Const strNachricht = "Anbei die komprimierte Bestellliste"

Deine Daten wie Pfad, unter der die Datei für die Mail zwischengespeichert werden soll, E-Mailadresse, den Text für den Mailbetreff und eine eventuelle Nachricht, musst Du natürlich anpassen.
Alles andere sollte ohne Einstellungen, außer den im obigen Text angesprochenenen Funktionen wie drucken oder sofort versenden, funktionieren.

Wenn nicht, dann melde Dich. Allerdings kann es dann sein, dass jemand anderes den Beitrag weiterführen muss, da ich ab heute nachmittag sehr zum Leidwesen meiner Frau, für 1 Woche auf Dienstreise bin.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo Oliver,

TAUSEND Dank erstmal!!!!!!!!!!!!!!!!!!!!!!! Wahnsinn, dass sieht super aus!!!!

Ich hab jetzt erstmal alles kopiert und die notwendigen Daten geändert, so wie du es beschrieben hast und siehe da es funktioniert einwandfrei!!!!!!!!!!!

Ich bin dir unendlich dankbar!!! Wahnsinn!!!!!!!!!!

Du hast mich vor einigen Haare-raufenden Stunden bewahrt!!!

Ich wünsch dir einen schönen Tag, eine angenehme Dienstreise und deiner Frau, dass die Zeit ganz schnell vergeht!

Liebe Grüße von der überglücklichen Praktikantin :-)

Answer 3

Hallo überglückliche Praktikantin,

gerne geschehen. Danke auch für die Rückmeldung.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]