VBA Macro

[motopdx]

I'm taking a data set (Sheet "Details") and separating data from that set based on a few drivers (2 different columns that represent the branch) and creating a new sheet within the same workbook. I have around a 100 locations that all need their own data tabs. I've provided an example for 2 locations which works but in order to have the macro work properly I have to repeat this macro and change the branch number. Is there a way to simplify this macro to break out the branch without having to write code for each location? Thank you for the help in advance.


' Branch 8
Sheets("Detail").Select
ActiveSheet.Range("$A$1").AutoFilter Field:=14, Criteria1:="8"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Name = "8"
'Copy next segment
Sheets("Detail").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1").AutoFilter Field:=19, Criteria1:="8"
ActiveSheet.Range("$A$1").AutoFilter Field:=14, Criteria1:="<>8"
Range("A2:W2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("8").Select
Range("A1").Select
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

' Branch 28
Sheets("Detail").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1").AutoFilter Field:=14, Criteria1:="28"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Name = "28"
'Copy next segment
Sheets("Detail").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1").AutoFilter Field:=19, Criteria1:="28"
ActiveSheet.Range("$A$1").AutoFilter Field:=14, Criteria1:="<>28"
Range("A2:W2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("28").Select
Range("A1").Select
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

 

[Fluff]

How about

Sub motopdx()
   Dim Ws As Worksheet
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array(8, 28, 38)
   
   With Sheets("Detail")
      For i = 0 To UBound(Ary)
         Set Ws = Sheets.Add(, Sheets(Sheets.Count))
         Ws.Name = Ary(i)
         .Range("A1").AutoFilter 14, Ary(i)
         .AutoFilter.Range.EntireRow.Copy Ws.Range("A1")
         .Range("A1").AutoFilter 14, "<>" & Ary(i)
         .Range("A1").AutoFilter 19, Ary(i)
         .AutoFilter.Range.EntireRow.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         .AutoFilterMode = False
      Next i
   End With
End Sub

 

[motopdx]

This is great and worked perfectly. Thank you very much for the quick reply and help.

 

[Fluff]

You're welcome & thanks for the feedback.