Copy-Paste range based on condition

Please check out following solution:

Sub filterRows()
Dim r, w As Long ' index for row of input data and output data
Dim down, up, current As Date 'variable for time

'init values
r = 3
w = 3
down = "07:00:00"
up = "17:00:00"

Do Until Cells(r, 1).Value = "" 'check next row till day will be empty
    current = Cells(r, 2).Value
    If current >= down And current <= up Then 'check criteria and copy data if necessary
       Cells(w, 8).Value = Cells(r, 1).Value
       Cells(w, 9).Value = Cells(r, 2).Value
       Cells(w, 10).Value = Cells(r, 3).Value
       Cells(w, 11).Value = Cells(r, 4).Value
       Cells(w, 12).Value = Cells(r, 5).Value
       Cells(w, 13).Value = Cells(r, 6).Value
       w = w + 1
    End If
r = r + 1
Loop
End Sub

You also shoud change formatting for cells in column H & I

Best Regards

Thank you very much. It works exactly as I expected

consider to mark this thread as solved

Best Regards