Autofilter

[27ashujain]

I have sales data of last 6 months in a sheet. Now I want to select data of last 3 months and paste it to a separate sheet and then select the data of last 6 months and then paste it to another sheet. This macro will be used for different set of data with different periods. Kindly provide me with an extract of macro which i can use. Thanks in Advance.

 

[Sektor]

First, the workbook with data is required. Second, the filter criteria is required.

 

[My Aswer Is This]

We would need a lot more specific data.

You gave no sheet names no column numbers where your data is located

No absolute definition of what last three months means.

For example does it mean last 90 days or last three complete months. like Jan:March ?

 

[My Aswer Is This]

Assuming you have a sheet named "Master" with all your dates in Column "A"
This script will ask you to enter start and stop months.
If you enter 1 in first Input box and 5 in second Input box.

The script will copy all rows from Sheet("Master") to a new sheet named Jan-May
If the date in column "A" falls between Jan 1 to May 31
Try it and see if this will work for you.

Sub Test()
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim iday As Integer
Dim FirstMonth As Long
Dim LastMonth As Long
Dim ans As String
FirstMonth = InputBox("Enter Starting Month")
If FirstMonth < 1 Or FirstMonth > 12 Then MsgBox "Number Must Be Between 1 and 12": Exit Sub
LastMonth = InputBox("Enter Last Month")
If LastMonth < 1 Or LastMonth > 12 Then MsgBox "Number Must Be Between 1 and 12": Exit Sub
ans = MonthName(FirstMonth, 9) & " - " & MonthName(LastMonth, 9)
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add(After:=Sheets("Master")).Name = ans
Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
    For i = 1 To Lastrow
        iday = Month(Sheets("Master").Cells(i, 1).Value)
        
            If iday >= FirstMonth And iday <= LastMonth Then
                Sheets("Master").Rows(i).Copy Destination:=Sheets(ans).Rows(Lastrowa)
                Lastrowa = Lastrowa + 1
            End If
    Next
Application.ScreenUpdating = True
    
Exit Sub
M:
    MsgBox "You entered some improper number or sheet name already exist"
Application.ScreenUpdating = True
End Sub