Apply sub filter in a range and paste the result in new workbook

If you want to apply filter on multiple columns and paste the result on a new workbook. Snapshot below-

Download Workbook

Here is the code-

Sub apply_sub_filter_on_different_fields()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wk As Worksheet
Dim wkb As Workbook
Set wk = ThisWorkbook.Sheets("Sample")
If wk.FilterMode Then
wk.ShowAllData
End If
i = wk.Range("a1").End(xlDown).Row
'apply filter
'apply filter on start date field first
' all date > 1 jan 2011
wk.Range("$A$1:$d$" & i).AutoFilter Field:=2, Criteria1:=">=" & Format(#1/1/2011#, "DD-MMM-yyyy")
'apply filter on end date field second
' all dates < 1 mar 2011
 wk.Range("$A$1:$d$" & i).AutoFilter Field:=3, Criteria1:="<=" & Format(#3/1/2011#, "DD-MMM-yyyy")
  'apply filter on name  field third
  wk.Range("$A$1:$d$" & i).AutoFilter Field:=1, Criteria1:="A"
Set Rng = wk.Range("$A$1:$d$" & i).SpecialCells(xlCellTypeVisible)
Rng.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
wkb.Sheets(1).Cells.EntireColumn.AutoFit
ActiveSheet.Name = "Data"
' delete blank sheet 2 and 3
   wkb.Sheets("Sheet2").Delete
 wkb.Sheets("Sheet3").Delete
 If wk.FilterMode Then
wk.ShowAllData
End If
' save thw workbook and close it
'wkb.SaveAs "path and filename with extension "
'wkb.close
 Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Download Workbook