Copy filtered data to new worksheet

[ndol]

Hi,
I have worksheet named Sheet1. I have 5 column :
vendor vat value vat value month
A Y 5000 500 JAN
B Y 8000 800 MAR
C N 7000 0 JUN

I want filter those data by vat & month cell then copy cell vendor & vat value to new worksheet named as month. If vat Y it will be copied to new worksheet named as month in its row.
Anybody please help for solution, thanks.

 

[Peter_SSs]

Hi,
I have worksheet named Sheet1. I have 5 column :
vendor vat value vat value month
A Y 5000 500 JAN
B Y 8000 800 MAR
C N 7000 0 JUN

I want filter those data by vat & month cell then copy cell vendor & vat value to new worksheet named as month. If vat Y it will be copied to new worksheet named as month in its row.
Anybody please help for solution, thanks.

Welcome to the MrExcel board!

This assumes that the individual 'month' sheets do not already exist in the workbook - it will error if they do (but could be modified to cope with this if needed). See if it is what you want. Post back if you need help with how to implement the code.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> VAT_And_Month()<br>    <SPAN style="color:#00007F">Dim</SPAN> myRange <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> m <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> myMonth <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Sheets("Sheet1")<br>        <SPAN style="color:#00007F">Set</SPAN> myRange = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 5)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> myRange<br>        .AutoFilter Field:=2, Criteria1:="=Y"<br>        <SPAN style="color:#00007F">For</SPAN> m = 1 <SPAN style="color:#00007F">To</SPAN> 12<br>            myMonth = Left(MonthName(m), 3)<br>            .AutoFilter Field:=5, Criteria1:=myMonth<br>            <SPAN style="color:#00007F">If</SPAN> .SpecialCells(xlCellTypeVisible).Count > 5 <SPAN style="color:#00007F">Then</SPAN><br>                Sheets.Add(After:=Sheets(Sheets.Count)).Name = myMonth<br>                .SpecialCells(xlCellTypeVisible).Copy _<br>                    Destination:=Sheets(myMonth).Range("A1")<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> m<br>        .AutoFilter<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[nirvana_]

Try this.

1) Open new workbook.
2) Put your data in sheet1 from Columns A to E.
3) Column B should have Y or N. And Column E should have month.
4 Run the code given below. The sorted data should be available on Sheet 2.

Sub SortMyData()
    Dim Rng As Range
    Set Rng = Worksheets(1).Columns("A:E")
    With Rng
        .Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("E2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        .AutoFilter Field:=2, Criteria1:="Y"
        .Copy
    End With
    Worksheets(2).Cells(1, 1).PasteSpecial Paste:=xlPasteValues
End Sub

 

[ndol]

Thanks Peter & Nirvana,
Your code is help greatly

 

[Dan88]

ADVERTISEMENT

Hi. Can anyone please help me utilize this useful code to my needs:
i pretty much need it to do the same thing, however i am filtering my names of clients and that data can be found on column 12 (L) of my sheet.

How can i utilize this code to name the sheets after the sort based on column L?

I started the code, but cant get it to work. anyone can chime in would be much appreciated....

Thanks!


Sub VAT_And_Month()
Dim myRange As Range
Dim m As Long
Dim myMonth As String

Application.ScreenUpdating = False
With Sheets("Sheet1")
Set myRange = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 5)
End With
With myRange
.AutoFilter Field:=12, Criteria1:="=Dan88"
For m = 1 To 12
myMonth = Left(MonthName(m), 3)
.AutoFilter Field:=5, Criteria1:=myMonth
If .SpecialCells(xlCellTypeVisible).Count > 5 Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = myMonth
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets(myMonth).Range("A1")
End If
Next m
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[ndol]

dear Dan,
This code assump myMonth filtre is still in range 5 of 12 :


Sub VAT_And_Month()
Dim myRange As Range
Dim m As Long
Dim myMonth As String

Application.ScreenUpdating = False
With Sheets("Sheet1")
Set myRange = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 12)
End With
With myRange
.AutoFilter Field:=12, Criteria1:="=Dan88"
For m = 1 To 12
myMonth = Left(MonthName(m), 3)
.AutoFilter Field:=5, Criteria1:=myMonth
If .SpecialCells(xlCellTypeVisible).Count > 12 Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = myMonth
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets(myMonth).Range("A1")
End If
Next m
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[Dan88]

ADVERTISEMENT

ndol,
Your code current name your added sheets after the months found on yoru column 5. What if my column 5 is not month but names of people?
how can i amend this code for my needs? it seems this vba is specifically for months on filtered data.
i want to filter my data by names of people and create new worksheets based on the filtered criteria.

Thanks!

 

[Dan88]

Hi Again. I was able to find a solution via Ron De Bruin, however i need help with a code:

his code uses a another module to identify the last cell of the filtered range.

Set My_Range = Range("A4:BR" & LastRow(ActiveSheet))
My_Range.Parent.Select

Via this module:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

How can i amend this code so that the filter range is not the last cell on my master sheet. I only need data filtered from A4:BR137.

Please help.
Thanks!

 

[Dan88]

Hi everyone.
I am in desparte need of assistance if you can just take a look at this code:

Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Range("A4:BR137").SpecialCells(xlCellTypeVisible)
Set Source = Nothing
On Error Resume Next
Set Source = Range("A4:BR137").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

This part sets the range for the code to copy, however before it does, can i drop a filter on there that looks like this:

Sheets("Sales").Select
Selection.AutoFilter Field:=11, Criteria1:="Dan88"
Selection.AutoFilter Field:=11

before it copies and paste visible cells?
I am having difficulty on how to combine the two to make it work?

Thanks in advance.