Hallo zusammen, bin neu hier in Forum und konnte leider nicht für meinen Problem eine Lösung im Forum finden, daher wende ich mich an euch :)

Ich habe eine Datenbank in einer Excel mit Kundendaten, die ständig erweitert wird. In dieser Tabelle sind viele Informationen über die Kunden, einige Daten aus dem Datenbank benötige ich für den Lieferschein sowie für die Rechnungserstellung.

Im laufenden Monat kommen neue Kunden hinzu und die wir ebenfalls in dem Monat beliefern müssen.
Die Lieferscheine und die Rechnungen haben eine eindeutige fortlaufende Nummer, die dem Kunden zugeordnet ist.
Ich möchte für die monatliche Belieferung der Kunden Monatsanfang eine neue Excel-Tabelle erstellen, die die Informationen (Name, Adresse, Ausgewähltes Produkt, etc...) erhält, um den Kunden beliefern zu können. Die Benötigten Daten sollen bereits aus de, bestehenden Excel-Datei übernommen werden. Bevor ich die Benötigte Daten in die neue Excelliste ziehe muss ich den Datenbank Filtern, da die Lieferungen aus zwei verschiedenen Standorten versendet bzw. verteilt werden.
Für die neue Exceldatei werden nicht alle Spalten aus Datenbank benötigt. Ich möchte zuerst die Daten nach vorgabe filtern und nur bestimmte Zellen in die neue Exceldatei kopieren. Nach/Während dem Kopieren soll jeder Kunden eine eindeutige Lieferschein- und Rechnungsnummer automatisch erhalten.
Kunden, die im Laufe eines Monats hinzukommen, sollen ebenfalls in der monatlichen Excel-Liste mit Lieferschein- und Rechnungsnummer zugeordnet werden. Dies soll am besten automatisch erfolgen.

Ich habe keine VBA Kenntnisse,ich habe bereits mit Chatgpt versucht aber es funktioniert bedingt. Die Daten werden nicht richtig gefiltert und alle Spalten aus dem Datenbank kopiert.

Datenbank: https://www.herber.de/bbs/user/169798.xlsm


Vielen Dank für eure Unterstützung.

Hier ist der Code von Chatgpt:

Sub ErstelleMonatlicheBelieferung()
Dim wbOriginal As Workbook
Dim wbZiel As Workbook
Dim wsOriginal As Worksheet
Dim wsZiel As Worksheet
Dim ZielZeile As Long
Dim i As Long
Dim LieferscheinNummer As Double
Dim RechnungsNummer As Double
Dim BlattName As String
Dim BlattGefunden As Boolean
Dim ZieldateiPfad As String
Dim ZieldateiName As String
Dim AktuellerMonat As Integer
Dim AktuellesJahr As Integer

' Debugging: Zeige eine Meldung an, um zu bestätigen, dass die Funktion gestartet wurde
MsgBox "Die Funktion ErstelleMonatlicheBelieferung wurde gestartet.", vbInformation

ZieldateiPfad = "C:\Users\mevlu\OneDrive\Desktop\" ' Hier den Pfad zur Zieldatei eintragen
ZieldateiName = "Monatliche Lieferdatei.xlsm" ' Hier den Namen der Zieldatei eintragen

' Aktuelles Datum abrufen
AktuellerMonat = Month(Date)
AktuellesJahr = Year(Date)

' Verwende die bereits geöffnete ursprüngliche Datei
Set wbOriginal = Workbooks("Kundenstammdaten REV002.xlsm")
Set wsOriginal = wbOriginal.Sheets("Datenbank")

' Verwende die bereits geöffnete Zieldatei oder öffne sie, falls sie noch nicht geöffnet ist
On Error Resume Next
Set wbZiel = Workbooks(ZieldateiName)
On Error GoTo 0

If wbZiel Is Nothing Then
Set wbZiel = Workbooks.Open(ZieldateiPfad & ZieldateiName)
End If

' Überprüfe, ob das Blatt "Tabelle1" in der Zieldatei existiert
For i = 1 To wbZiel.Sheets.Count
BlattName = wbZiel.Sheets(i).Name
If BlattName = "Tabelle1" Then
BlattGefunden = True
Exit For
End If
Next i

If Not BlattGefunden Then
MsgBox "Das Blatt 'Tabelle1' wurde nicht in der Zieldatei gefunden.", vbExclamation
Exit Sub
End If

Set wsZiel = wbZiel.Sheets("Tabelle1")

' Überschriften kopieren
wsOriginal.Range("B11:AB11").Copy Destination:=wsZiel.Range("A1")

' Lieferschein- und Rechnungsnummern initialisieren
LieferscheinNummer = 2030000000# ' Startnummer für Lieferscheine
RechnungsNummer = 3030000000# ' Startnummer für Rechnungen

ZielZeile = wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Row + 1 ' Finden der ersten leeren Zeile in der Zieldatei

' Durchlaufen der Datenbank und Kopieren der relevanten Daten basierend auf den Kriterien in den Zellen E11 und U11
Dim DatenbankZeile As Long
For DatenbankZeile = 12 To wsOriginal.Cells(wsOriginal.Rows.Count, 2).End(xlUp).Row
If wsOriginal.Cells(DatenbankZeile, 5).Value = "Genehmigt" And _
(wsOriginal.Cells(DatenbankZeile, 21).Value = "In House" Or _
wsOriginal.Cells(DatenbankZeile, 21).Value = "Agila" Or _
wsOriginal.Cells(DatenbankZeile, 21).Value = "DHL/Hermes") Then
' Kopieren der relevanten Daten in die Zieldatei
wsOriginal.Cells(DatenbankZeile, 2).Resize(, 22).Copy Destination:=wsZiel.Cells(ZielZeile, 1)
' Hinzufügen der Lieferschein- und Rechnungsnummern
wsZiel.Cells(ZielZeile, 23).Value = LieferscheinNummer ' AC ist die 23. Spalte
wsZiel.Cells(ZielZeile, 24).Value = RechnungsNummer ' AD ist die 24. Spalte
' Aktualisieren der Nummern für den nächsten Eintrag
LieferscheinNummer = LieferscheinNummer + 1
RechnungsNummer = RechnungsNummer + 1
' Aktualisieren der Zielzeilennummer für den nächsten Eintrag
ZielZeile = ZielZeile + 1
End If
Next DatenbankZeile

' Zeige eine Nachricht an
MsgBox "Monatliche Belieferungsliste erstellt!"
End Sub