Download The Workbook

Private Sub CommandButton1_Click()
Dim max As Long
max = 12
last = ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
s = 3

For i = 1 To max
If s > Sheets.Count Then
Worksheets.Add after:=Worksheets(Sheets.Count)
ActiveSheet.Name = "Sheet" & s
End If
e = Sheets("Sheet" & s).Range("A" & Rows.Count).End(xlUp).Row
For Q = 2 To last
Sheets(2).Activate
If Month(Range("B" & Q)) = i Then
Range(Cells(Q, 1), Cells(Q, 7)).Select
Selection.Copy Destination:=Sheets("Sheet" & s).Range("A" & e)
End If

e = Sheets("Sheet" & s).Range("A" & Rows.Count).End(xlUp).Row + 1

Next
s = s + 1
Next

MsgBox ("Hi Completed")
End Sub