Datum suchen und darunter neue identische Zeile einfügen

Set rng = ActiveSheet.Cells.Range("B:B").Find(what:=Date, LookIn:=xlFormulas, lookat:=xlWhole)

Private Sub today_Click()



    Dim xRow As Integer

    Dim rng As Range

    Dim rngTo As Integer

    Dim n As Integer

    Dim searchDate As Date

    searchDate = Date ' Aktuelles Datum



    ' Debugging Punkt: Überprüfen, ob der Wert in B gefunden wird

    Debug.Print "Suche nach Datum: " & searchDate



    ' Datum in Spalte B suchen (und mit CDate sicherstellen, dass es als Datum erkannt wird)

    'Das hier klappt, wenn ich in Excel nicht nur die Tage anzeigen lasse (Benutzerdefiniert TT), sondern das Format in Excel auf TT.MM.JJJJ anpasse. Das möchte ich aber nicht.

    'Set rng = ActiveSheet.Columns("B").Find(what:=CDate(searchDate), LookIn:=xlValues, lookat:=xlWhole)



    ' Suche nach dem Datum in Spalte B und vergleiche nur den Tag (TT)

    ' Das hier findet immer nur den 19.01.2025

    Set rng = ActiveSheet.Columns("B").Find(what:=Format(searchDate, "dd"), LookIn:=xlValues, lookat:=xlWhole)





    ' Überprüfen, ob das Datum gefunden wurde

    If Not rng Is Nothing Then

        Debug.Print "Datum gefunden in Zeile: " & rng.Row

        rngTo = rng.Row + 30



        ' Schleife durch die Zeilen bis rngTo

        For n = rng.Row To rngTo

            Debug.Print "Zeile " & n & ": " & ActiveSheet.Cells(n, 2).Value

            ' Wenn der Wert entweder das nächste Datum ist oder die Zelle leer ist, breche ab

            If ActiveSheet.Cells(n, 2).Value = searchDate + 1 Or ActiveSheet.Cells(n, 2).Value = "" Then

                Exit For

            End If

        Next n



        ' Zeile für die neuen Daten festlegen

        xRow = n

        Debug.Print "Neue Zeile: " & xRow



        ' Neue Zeile einfügen und Werte zuweisen

        Rows(xRow & ":" & xRow).Insert Shift:=xlDown

        Cells(xRow, 1).Value = searchDate

        Cells(xRow, 2).Value = searchDate



        ' Formeln aus der vorherigen Zeile kopieren und in die neue Zeile einfügen

        Range("L" & xRow - 1 & ":O" & xRow - 1).Copy

        Range("L" & xRow).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats

        Application.CutCopyMode = False



        ' Zelle C(xRow) auswählen

        Range("C" & xRow).Select



    Else

        MsgBox "Datum nicht gefunden!"

        Debug.Print "Datum nicht gefunden!"

    End If



    ' Form geschlossen

    Unload Datumswahl



End Sub