Apply Filter on Dates And copy the output to new workbook

If you want to apply filter on dates and then copy the result to new workbook.

1) Applying Autofilter on dates
2) Copy the Filtered data to new workbook

For Example you have a data sheet like

You want to filter the records who's dates are between cell H1 & M1

Here is the code
Sub filterbetweendates()
Dim i As Long

Dim wkb, wkb1 As Workbook
Set wkb1 = ThisWorkbook

i = Range("a2").End(xlDown).Row

' this if condition will remove if any filter applied in sheet 1
If wkb1.Sheets(1).FilterMode Then
wkb1.Sheets(1).ShowAllData
End If

' this if condition will check if the start date entered by the user is present in col c or not
If Application.WorksheetFunction.CountIf(Sheets(1).Range("c:c"), Sheets(1).Cells(1, 8).Value) = 0 Then
Sheets(1).Cells(1, 8).Value = ""
MsgBox "Enter the date in cell H1 Which is present in the column C"
Exit Sub
End If


' this if condition will check if the end date entered by the user is present in col c or not and end date > start date


If Application.WorksheetFunction.CountIf(Sheets(1).Range("c:c"), Sheets(1).Cells(1, 13).Value) = 0 Or Sheets(1).Cells(1, 13).Value < Sheets(1).Cells(1, 8).Value Then

 Sheets(1).Cells(1, 13).Value = ""

MsgBox "Enter the date in cell m1 Which is present in the column C and it should be greater than start date "
 Exit Sub
End If

 'apply filter

 wkb1.Sheets(1).Range("$A$2:$C$" & i).AutoFilter Field:=3, Criteria1:= _ "&>=" & Format(wkb1.Sheets(1).Cells(1, 8).Value, "DD-MMM-yy"), Operator:=xlAnd, Criteria2:="&<=" &Format(wkb1.Sheets(1).Cells(1, 13).Value, "DD-MMM-yy")

Sheets(1).Range("$A$2:$C$" & i).SpecialCells(xlCellTypeVisible).Select

 Selection.Copy

 ' new workbook is added

Workbooks.Add Set wkb = ActiveWorkbook '

 filtered data is pasted on sheet1 of a new workbook

wkb.Sheets(1).Select ActiveSheet.Paste

 ' save new workbook and you can change the file name

 'wkb.SaveAs ThisWorkbook.Path & "\New_Week_Report" & ".xls"
 ' new workbook is closed
 'wkb.Close

 If wkb1.Sheets(1).FilterMode Then

wkb1.Sheets(1).ShowAllData

 End If

 End Sub

 Download Sample Workbook Click Here