filter a worksheet many times over, create new sheets/books

Gingertrees

Well-known Member
Joined
Sep 21, 2009
Messages
697
I wish to make new sheets from a large worksheet of data. The data for these sheets will be based on groups of states and designations (red or green).
So if Group 1 is the TexArkAna states, I want a sheet for group 1 red, and another for group 1 green. I then want to export these 2 new sheets into their own workbook.
Repeat process with Group 2 states, Group 3, 4, ... 15.

Sheet is set up with these 11 columns:
ID / Name / Address / Address2/ Address3 / City / St / Zip / Country / Phone / Designation

I've recorded a macro (somewhat cleaned below) to start, but this missed things like "copy to new workbook". Please help?? Thanks.

(Note: I anticipate storing this macro in text-form for use in other data sheets later on, which is why I'm planning code because I've already done this twice manually)
Code:
Sub filtercreatesepsheets()
' filtercreatesepsheets Macro
    Selection.AutoFilter
    '/////filter for designation = red
    ActiveSheet.Range("$A$1:$K$6000").AutoFilter Field:=11, Criteria1:="red"
    '/////2nd filter: state range of Texarkana, group 1
    ActiveSheet.Range("$A$1:$K$6000").AutoFilter Field:=7, Criteria1:=Array( _
        "AR", "LA", "TX"), Operator:=xlFilterValues
    Range("A1:K6000").Select
    Selection.Copy
    '////copy used filtered range, paste values to new sheet
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    '/////name copied sheet group1active
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Group1red"
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$1:$K$6000").AutoFilter Field:=11, Criteria1:="green"
    '/////filter for designation = green
    Range("A1:K6000").Select
    Range("H170").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    '////copy used filtered range, paste values to new sheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Group1green"
    '////name copied sheet (green flags) group1green
    Sheets("Sheet1").Select
    '///change state filter to 3 other states to make group 2
    ActiveSheet.Range("$A$1:$K$6000").AutoFilter Field:=7, Criteria1:=Array( _
        "AL", "MS", "TN"), Operator:=xlFilterValues
    '///filter for red values
    ActiveSheet.Range("$A$1:$K$6000").AutoFilter Field:=11, Criteria1:="red"
    Range("A1:K6000").Select
    Range("B324").Activate
    Application.CutCopyMode = False
    '////copy used filtered range, paste values to new sheet
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Group2red"
    '///name group2red
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$1:$K$6000").AutoFilter Field:=11, Criteria1:="green"
    '///filter for greens
    Range("A1:K6000").Select
    Range("C292").Activate
    '////copy used filtered range, paste values to new sheet
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    '///name group2green
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "Group2green"
    
    Sheets(Array("Group1red", "Group1greem")).Select
'//select both Group1 sheets
    Sheets("Group1Active").Activate
    Application.CutCopyMode = False
'//move group1 sheets to new workbook
    Sheets(Array("Group1red", "Group1green")).Copy
    Windows("Book1.xlsm").Activate
    ActiveWindow.WindowState = xlNormal
    ActiveWindow.WindowState = xlNormal
    Sheets(Array("Group1red", "Group1green")).Select
'//select both Group2 sheets
    Sheets("Group2red").Activate
    Sheets(Array("Group2red", "Group2green")).Copy
'//move group2 sheets to new workbook
    Windows("Book1.xlsm").Activate
    ActiveWindow.WindowState = xlNormal
    ActiveWindow.WindowState = xlNormal
    Selection.AutoFilter
'//
End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Oh wow, that's way better than my code. Thanks a lot - top shelf code, VoG. :) Just what I needed.
 
Upvote 0

Forum statistics

Threads
1,215,066
Messages
6,122,948
Members
449,095
Latest member
nmaske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top