Gleiche Werte suchen und ausgeben
04.04.2020 11:02:11
Wolfgang
ich habe in einer Arbeitsmappe unter anderem ein Tabellenblatt "Kundenbestellungen" mit 11 Spalten.
In Spalte 1 steht der Name des Kunden, in Spalte 4 die Artikelnummer und in Spalte 5 die Artikelbezeichnung.
In Spalte 9 steht das Lieferdatum. Die anderen Spalten beinhalten noch weitere Daten zur Bestellung wie Bestellnummer, Preise usw. und sind für mein Vorhaben nicht relevant.
Ich möchte das mir beim Öffnen der Arbeitsmappe (Das erste Tabellenblatt heisst "Startseite") alle Bestellungen mit heutigem Liefertermin in einer Messagebox angezeigt werden.
Nach langem hin und herprobieren habe ich folgenden Code zusammengebastelt, der zwar die erste Bestellung mit heutigem Datum findet und ausgibt, aber die weiteren natürlich nicht. Ich habe leider keine Erfahrungen mit Do und Loop. Und was ich darüber bisher gefunden habe hat mir auch nicht wirklich weitergeholfen.
Schön wäre es wenn die gefundenen Daten mit samt den ganzen dazugehörigen Zeilen auch direkt in ein anderes Tabellenblatt kopiert werden könnten, dann könnte ich damit vielleicht auch noch was anderes machen. Zum Beispiel gleich die Rechnung schreiben, o. ä.
Falls mir hier jemand weiterhelfen könnte wäre ich sehr dankbar.
Mein Code bisher:
Private Sub Workbook_Open()
'Bestellungen mit heutigem Datum finden und daran erinnern
Application.ScreenUpdating = False
Application.DisplayAlerts = True
Sheets("Startseite").Range("M7") = "" ' diese Zellen habe ich nur als
Sheets("Startseite").Range("M8") = "" 'Platzhalter verwendet.
Sheets("Startseite").Range("M9") = ""
Dim rng As Range
Dim Datum As Long ' Das Datum in Spalte 9 ist übrigens als Zahl formatiert
Datum = Date
Set rng = Worksheets("Kundenbestellung").Range("I:I").Find(Datum)
If rng Is Nothing Then
GoTo Keine_Lieferung
Else
rng.Columns(1 - 8).Copy
Sheets("Startseite").Paste Destination:=Sheets("Startseite").Range("M7")
rng.Columns(1 - 4).Copy 'Dito Spalte 4
Sheets("Startseite").Paste Destination:=Sheets("Startseite").Range("M8")
rng.Columns(1 - 5).Copy 'Dito Spalte 5
Sheets("Startseite").Paste Destination:=Sheets("Startseite").Range("M9")
Kunde = Sheets("Startseite").Range("M7")
Artikelnummer = Sheets("Startseite").Range("M8")
Bezeichnung = Sheets("Startseite").Range("M9")
Sheets("Kundenbestellung").Visible = False
Application.CutCopyMode = False
Sheets("Startseite").Activate
Application.ScreenUpdating = True
MsgBox "Heute Ausliefern:" & Chr(10) & Kunde & Chr(10) & Artikelnummer & Chr(10) & Bezeichnung
End If
Exit Sub
Keine_Lieferung:
Sheets("Kundenbestellung").Visible = False
Application.CutCopyMode = False
Sheets("Startseite").Activate
Application.ScreenUpdating = True
MsgBox "Heute keine Lieferungen!"
Exit Sub
End Sub