AutoFilter data Question

[robcarr]

Dear All,

I currently use coding below to copy all the data using an autofilter,( I have the coding copied 10 times for each different type) The values in column E (filter option 5) can change all the time, and each time they change I have to make extra coding for each item, is there a way to filter out and copy every instance that appears in colum E, and perform the same task, what the coding currently does is filter by the type, and then copies the data to a new file - new file is created at the start of the routine and adds 10 sheets,each filter type goes on to a different sheet and then the new file is saved to disk. IS it possible to just filter each different option in the column and not specify the type you wish to filter, as I have the same coding for 3 different files and I have to change all 3 files at the moment, Hope I have made sense, and I hope someone can help with this.

The Coding to filter out the data

Selection.AutoFilter Field:=5, Criteria1:= _
"Internal Escalated To Mail Team Open"
Range("A:d,H:J&quot.Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ActivatePrevious
Sheets("Sheet3&quot.Select
Sheets("Sheet3&quot.Name = "Mail Team"
ActiveSheet.Paste
Sheets("Call Back&quot.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Mail Team&quot.Select
Range("H7&quot.Select
ActiveSheet.Paste
Columns("E:E&quot.EntireColumn.AutoFit
Range("E9&quot.Select
Sheets("Sheet4&quot.Select
ActiveWindow.ActivateNext

Any help will be greatly appreciated.

Thanks

 

[BrainB]

I think I understand what you want. Get database data to separate worksheets, right ? I suggest you make a pivot table of your data and copy/paste the following macro :-

'------------------------------------------
'- macro to extract data from a pivot table
'- to separate sheets.
'- amend code below as necessary
'- run macro from the pivot table sheet
'------------------------------------------

Sub PIVOT_DATA_TO_WORKSHEETS()
    Dim ToBook As String
    Dim ToSheet As Worksheet
    Dim FromSheet As Worksheet
    Dim MyTable As PivotTable
    Dim MyField As PivotField
    Dim MyFieldName As String
    Dim MyItem As String
    Dim MyRange As Range
    '--------------------------------------------------
    '- amend names
    ToBook = "MyNewBookName" & ".xls"
    MyFieldName = "PROJECT NUMBER"
    '- initialise
    Set FromSheet = ActiveSheet
    Set MyTable = FromSheet.PivotTables("PivotTable1")
    Set MyField = MyTable.PivotFields(MyFieldName)
    '- make new workbook
    Workbooks.Add
    ActiveWorkbook.SaveAs ToBook
    '- transfer data
    For Each Pi In MyField.PivotItems
        MyItem = Pi.Value
        FromSheet.Activate
        MyTable.PivotSelect MyItem, xlDataOnly
        Selection.ShowDetail = True
        ActiveSheet.Name = MyItem
        ActiveSheet.Move after:=Workbooks(ToBook). _
            Sheets(Workbooks(ToBook).Sheets.Count)
        ActiveSheet.Range("A1").Select
    Next
    Application.Goto Workbooks(ToBook).Worksheets(1).Range("A1")
    Workbooks(ToBook).Save
End Sub
'----------------------------------------------------------

Regards
BrianB
** Let us know if you get something that works !
================================

 

[robcarr]

Brian,

Thanks for doing this, I do however need to go along the filter route, as I have to copy other data on the sheet when the data is filtered, I have to copy columns a-d and h-j to the other sheet.

Regards