Excel: Höchsten Wert pro Tag auslesen und in ein neues Excel File überspielen

Sub CSV_Import()
    Dim vntaDateien As Variant
    Dim lngI As Long
    Dim lngLetzteZeile As Long
    Dim wbkCSV As Workbook
    Dim wksZiel As Worksheet
    Dim rOut As Range
    Set rOut = Range("A1")  
    lngLetzteZeile = 1
    With rOut.Range("A1:G1").Resize(rOut.Worksheet.Rows.Count - rOut.Row + 1)  
        .ClearContents
        .Rows(1).Value = Split("Date,Time,Durchfluss1,Durchfluss2,lt101 cm,lt102 cm,tt101 C", ",")  
    End With
    lngLetzteZeile = 1
    vntaDateien = Application.GetOpenFilename _
    ("csv-Dateien (*.csv), *.csv", MultiSelect:=True)  
    If IsArray(vntaDateien) Then
        Set wksZiel = ThisWorkbook.Sheets(1)
        For lngI = 1 To UBound(vntaDateien)
            lngLetzteZeile = wksZiel.UsedRange.Rows.Count
            lngLetzteZeile = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
            Set wbkCSV = Workbooks.Open(vntaDateien(lngI), local:=True)
            'sortieren  
            wbkCSV.Worksheets(1).Sort.SortFields.Clear
            wbkCSV.Worksheets(1).Sort.SortFields.Add Key:=Range("C2:C1048576"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal  
            wbkCSV.Worksheets(1).Sort.SortFields.Add Key:=Range("D2:D1048576"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal  
            With wbkCSV.Worksheets(1).Sort
                .SetRange Range("A1:G1048576")  
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
            'Zeilen 3 bis Ende löschen  
            wbkCSV.Worksheets(1).Rows("3:1048576").Delete shift:=xlUp  
            'Dateiname kopieren  
            'wksZiel.Cells(lngLetzteZeile + 1, 1) = vntaDateien(lngI)  
            'Bereich kopieren  
            'wbkCSV.Sheets(1).UsedRange.Copy Destination:=wksZiel.Cells(lngLetzteZeile + 2, 1)  
            'nur die 2. Zeile kopieren  
            wbkCSV.Sheets(1).Rows("2:2").Copy Destination:=wksZiel.Cells(lngLetzteZeile + 1, 1)  
            wbkCSV.Close False
        Next
    End If
    wksZiel.Columns("A:G").EntireColumn.AutoFit  
    With wksZiel.Columns("A:G")  
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Sub ZeilenFiltern()
Set Quelle = ThisWorkbook
Set Ziel = Workbooks.Add

Zieldatei = "D:\Auszug.xlsx" 'Pfad der Zieldatei  
ZZeile = 1 'erste Zeile der Zieltabelle  
QZeile = 1 'erste zu verarbeitende Zeile der Quelltabelle  
QSpalten = 5 'erste 5 Spalten der Quelltabelle übertragen  
QKritSpalte = "B" 'Spalte mit dem Kriterium (Timestamp)  

Zuletzt = 0 ' Startwert für Datum setzen  
With Quelle.Worksheets(1)
    'Überschriftenzeile übertragen  
    Ziel.Worksheets(1).Cells(ZZeile, "A").Resize(1, QSpalten) = .Cells(QZeile, "A").Resize(1, QSpalten).Value 'Zellen ab Spalte A übertragen  
    QZeile = QZeile + 1 'nächste Zeile der Quelldatei  
    ZZeile = ZZeile + 1 'nächste Zeile der Zieldatei  
    
    Datum = Int(.Cells(QZeile, QKritSpalte).Value) 'Datum aus aktueller Zeile der Quelldatei auslesen  
    Zeit = .Cells(QZeile, QKritSpalte).Value - Datum 'Uhrzeit aus aktueller Zeile der Quelldatei ermitteln  
    Do Until Datum = 0 'alle Datenzeilen der Quelldatei durchgehen  
        If Datum <> Zuletzt Then 'nur einen Datensatz / Tag  
            If Zeit >= 0.5 Then ' 0.5 = 12:00:00  
                Ziel.Worksheets(1).Cells(ZZeile, "A").Resize(1, QSpalten) = .Cells(QZeile, "A").Resize(1, QSpalten).Value 'Zellen ab Spalte A übertragen  
                ZZeile = ZZeile + 1 'nächste Zeile der Zieldatei  
                Zuletzt = Datum 'verarbeitetes Datum zwischenspeichern  
            End If
        End If
        QZeile = QZeile + 1 'nächste Zeile der Quelldatei  
        Datum = Int(.Cells(QZeile, QKritSpalte).Value) 'Datum aus aktueller Zeile der Quelldatei auslesen  
        Zeit = .Cells(QZeile, QKritSpalte).Value - Datum 'Uhrzeit aus aktueller Zeile der Quelldatei ermitteln  
    Loop
End With
Ziel.Worksheets(1).Columns.AutoFit 'alle Spalten der Zieldatei auf optimale Breite setzen  
Ziel.SaveAs Zieldatei 'Zieldatei speichern  
End Sub