Show All Multi sheets Data one sheet 1 between two dates

[hsolanki]

Hi i have a workbook whereby it has multi sheets of different information on each tab. and all sheets on column "A" has got date and time.

is there away to filter all data from all sheets into sheet1 between two dates selected from all sheets column "A" without compromising all the data on all other sheets.

and command button to reset all the sheet1 back to normal

i would be greatful if anybody could help me as i fairly new on VBA

Thank you in advance

 

[hsolanki]

Hi i would be really apricate if someone could help me with the above please.

i have started some below however i need some to help me finish of the code to find using thw two beteen dates and Name and display all the data that is on VehicleRejected sheet. Dates in column A and names are in column H

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("H8,K8,K10")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    
    Dim LastRow As Long, dic As Object, srcWS As Worksheet, advis As Range, rDate As Range
    Set srcWS = Sheets("VehicleRejected")
    
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set dic = CreateObject("Scripting.Dictionary")
    Select Case Target.Address
        Case "$H$8", "$K$8"
            CalendarFrm.Show
        Case "$K$10"
            For Each advis In srcWS.Range("H5:H" & LastRow)
                If Not dic.Exists(advis.Value) Then
                    dic.Add advis.Value, Nothing
                End If
            Next advis
            With Target.Validation
                .Delete
                .Add xlValidateList, , , Join(dic.Keys, ",")
            End With
    End Select
    Application.ScreenUpdating = True
End Sub

Sub ShowData()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("VehicleRejected")

     Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, advis As Range, RowCount As Long
    Set srcWS = Sheets("VehicleRejected")
    Set desWS = Sheets("Sheet1")
    
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sh.Unprotect "Bhaji2020"
    With srcWS
        .Cells(5, 1).CurrentRegion.AutoFilter 9, Range("K10").Value
        .Cells(5, 1).AutoFilter 9, Criteria1:=">=" & Range("K8"), Operator:=xlAnd, Criteria2:="<=" & Range("H8")
       
        If Range("H8") >= Now() < -5 Then
        
            MsgBox ("No data to copy.  Please check the criteria.")
            .Range("A5").AutoFilter
        Else
            .AutoFilter.Range.Offset(1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
        End If
        .Range("A5").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

I need also an reset button whereby it clears all the extract data from sheet 1

 

[hsolanki]

can someone please help me really struggling