VBA Unique Filter und Kopieren

Moin zusammen,
ich arbeite jetzt seit geraumer Zeit an einer Excel liste mit VBA und allem drum und dran in Excel 365.
In vergangener Zeit konnte mir das Forum schon immer ganz gut weiterhelfen. Jedoch bin ich scheinbar jetzt an einem Punkt wo ich nicht mehr weiter komme.
Ich habe eine Liste in dem Ausgänge eingetragen werden per Userform mit allem drum und dran. Jetzt brauche ich allerdings eine Möglichkeit diese Einträge irgendwie nach Datum zu Filtern und dann diese Einträge in eine Seperate Excelfile zu kopieren. Im Anschluss müssen diese Einträge dann Markiert werden sodass sie nicht noch einmal aufgerufen werden können.
Sprich ich brauche einen Filter welcher zwischen Start-,Enddatum sucht und nach dem "X" in einer Zeile welche sagt das dieser Eintrag bereits einmal weitergegeben wurde. Da ist leider mein Latein am Ende und ich könnte echt ein wenig Hilfe benötigen.
Userbild

In B wird das Datum angegeben und in O soll das X markiert werden.
Eventuell kann mir da jemand weiterhelfen.
PS:
Ich habe bereits einen versuch gestartet und eine Userform dafür eingefügt welche lediglich im Datumsformat akzeptiert wird. Um die Eingabe zu vereinfachen habe ich bei der Inizialierung bereits das Datum eintragen lassen. Jetzt kommt allerdings ein ganz wildes Ergebnis dabei heraus. Das Startdatum wird in Europäischem Datum Formatiert Sprich bspw. 12.12.2022. Das Enddatum wird allerding im Englischen Datumsformat Formatiert sprich 12/12/2022. Kann mir da jemand mal sagen wie ich das Fixen kann?
Userbild


Option Explicit
Private Sub CommandButton1_Click()
bolAbbruch = True
Unload Me
End Sub
Private Sub CommandButton2_Click()
Artikel_Vor = TextBox1
Artikel_Zurück = TextBox2
Unload Me
End Sub
Private Sub TextBox1_AfterUpdate()
TextBox1 = Format(TextBox1, "dd.mm.yyyy")
End Sub
Private Sub TextBox2_AfterUpdate()
TextBox2 = Format(TextBox2, "dd.mm.yyyy")
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextBox1) Then
TextBox1 = ""
Cancel = True
End If
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextBox2) Then
TextBox2 = ""
Cancel = True
End If
End Sub
Private Sub UserForm_Initialize()
TextBox1 = Date
TextBox2 = Date
End Sub

Ist bestimmt nicht der schönste Code aber funktioniert erstmal.
Vielen dank an jeden der sich die Zeit nimmt und mir Helfen kann.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub BetweenDates(Artikel_Vor, Artikel_Zurück) Dim sDate As Long Dim EDate As Long Dim filter As String Dim strFile As String Dim Path As String Dim path_blank As String Dim oFSO As Object Dim xDate As String xDate = Date filter = "" sDate = Artikel_Vor EDate = Artikel_Zurück Application.ScreenUpdating = False With Workbooks("test.xlsm").Worksheets("Ausgang") .Range("B8:B999").AutoFilter 2, "=" & EDate .Range("O8:O999").AutoFilter 15, "=" & filter End With path_blank = "C:\Users\Linus\Desktop\XXXXX\Data\logiqVorlage.xlsx" 'Festlegen des Blanked Pfades Path = "C:\Users\Linus\Desktop\XXXXX\Logiq-Dateien\" 'Festlegen des Lagerabrechnungs-Pfad strFile = Path & "Logiq-Import-" & xDate & ".xlsx" Set oFSO = CreateObject("Scripting.FileSystemObject") 'Ausführen des Kopierens Call oFSO.CopyFile(path_blank, strFile) Worksheets("Ausgang").Range("A8:O999").SpecialCells(xlCellTypeVisible).Copy Workbooks.Open(strFile) _ .Worksheets("Importdaten") _ .Range("A2").PasteSpecial xlPasteValues ActiveWorkbook.Save ActiveWorkbook.Close With Worksheets("Ausgang") .Range("O8:O999").SpecialCells(xlCellTypeVisible) = "X" .ListObjects("Tabelle1").Range.AutoFilter Field:=2 .ListObjects("Tabelle1").Range.AutoFilter Field:=15 End With Application.ScreenUpdating = True End Sub

Moin Pierre,
danke erstmal das du dir die Mühe gemacht hast und dir das angeguckt hast.
Unter dem Code findest du die Excel Datei komplett. Dort ist dann auch die Startfunktion womit dieses Makro aufgerufen wird. Alternativ kann für Artikel_Vor und Artikel_Zurück auch jeweils ein Datum genutzt werden dann sollte das auch laufen.
Der Pfad ist ja leicht änderbar und kann in jedes beliebige Workbook laufen.
Das einzige Problem das ich nun noch habe ist bei:


Worksheets("Ausgang").Range("A8:O999").SpecialCells(xlCellTypeVisible).Copy

bekomme ich einen Fehler das die Copy Bezeichnung nicht ausgeführt werden konnte da keine Zellen gefunden wurden.
Ich denke das ist relativ schnell erledigt durch Verwendung von On Error aber leider habe ich da gerade noch nicht den Faden gefunden wo das wie eingebunden werden muss. Dabei benötige ich einmal einen Rat.
Linus

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Unique Filter und Kopieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread