How do I create new worksheets from a main worksheet based on date range

[Sandry]

I have a set of data that I'm pulling from quickbase and am trying to figure out a better way than c&p to create new worksheets based on date ranges. For example, I have 8 columns and 4k+ rows. One of the columns is called Date Modified and has dates ranging from 2/7/2016 to today. I would like to create new worksheets that separate the data by Quarter while leaving the main worksheet intact. I tried using advanced filter but I haven't been able to figure out how to use that with a date range instead of a word/number/specific date. Is there a way to do that or a better way altogether to accomplish my goal?

 

[DanteAmor]

Hi and welcome to MrExcel.

In the following code change "Main" for the name of your sheet. Change "D" to the column where you have the dates.
The macro assumes that your headings are in row 1.
The sheets will be created with the names: 1-2016, 2-2016, 3-2016, 4-2016, 1-2017 and so on.

Sub CreateSheetsByQuarter()
  Dim sh As Worksheet
  Dim y1 As Long, i As Long, q As Long
  Dim col As String, sName As String
  Dim StartDate As Date, EndDate As Date, Date2 As Date
  '
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  '
  Set sh = Sheets("Main")
  col = "D"
  '
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  y1 = Year(WorksheetFunction.Min(sh.Range(col & ":" & col)))
  StartDate = DateSerial(y1, 1, 1)
  EndDate = WorksheetFunction.Max(sh.Range(col & ":" & col))
  i = 1
  Do While StartDate <= EndDate
    Date2 = DateSerial(Year(StartDate), Month(StartDate) + 3, 1) - 1
    sh.Range(col & "1:D" & sh.Range(col & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, _
      Criteria1:=">=" & Format(StartDate, "mm/dd/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(Date2, "mm/dd/yyyy")
    q = q + 1
    If q = 5 Then q = 1
    sName = q & "-" & Year(StartDate)
    On Error Resume Next
      Sheets(sName).Delete
      Sheets.Add(, Sheets(Sheets.Count)).Name = sName
      sh.AutoFilter.Range.EntireRow.Copy Range("A1")
    On Error GoTo 0
    i = i + 3
    StartDate = DateSerial(y1, i, 1)
  Loop
End Sub