Não entendi direito. Como assim filtrar? No caso, você que escolhe o nome da chefia e depois criar uma nova pasta de trabalho com esse nome?
Como você planeja filtrar? Através de um formulário, digitando o nome da chefia e automaticamente criando a pasta de trabalho?

Bom dia!!

Você consegue adaptar essa obra de arte?

Sub ParseItems()
'JBeaucaire  (11/11/2009)
'Based on column selected, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
Dim LR As Long, i As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr
Application.ScreenUpdating = False

'Determine column to evaluate from, column A = 1, B = 2, etc.
   vCol = 1

'Sheet with data in it, make it active
   Set ws = Sheets("Sheet1")

'Spot bottom row of data
   LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range("A1:Z1").AutoFilter

'Loop through list one value at a time
For i = 1 To UBound(MyArr)
    ws.Range("A1:Z1").AutoFilter Field:=vCol, Criteria1:=MyArr(i)
    
    If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then    'create sheet if needed
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
    Else                                                     'clear sheet if it exists
        Sheets(MyArr(i)).Move After:=Sheets(Sheets.Count)
        Sheets(MyArr(i)).Cells.Clear
    End If
    
    ws.Range("A1:Z" & LR).Copy
    Sheets(MyArr(i)).Range("A1").PasteSpecial xlPasteAll
    ws.Range("A1:Z1").AutoFilter Field:=vCol
    MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
    Sheets(MyArr(i)).Columns.AutoFit
Next i

'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

Att

Bom dia!!

Você consegue adaptar essa obra de arte?

Sub ParseItems()
'JBeaucaire  (11/11/2009)
'Based on column selected, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
Dim LR As Long, i As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr
Application.ScreenUpdating = False

'Determine column to evaluate from, column A = 1, B = 2, etc.
   vCol = 1

'Sheet with data in it, make it active
   Set ws = Sheets("Sheet1")

'Spot bottom row of data
   LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range("A1:Z1").AutoFilter

'Loop through list one value at a time
For i = 1 To UBound(MyArr)
    ws.Range("A1:Z1").AutoFilter Field:=vCol, Criteria1:=MyArr(i)
    
    If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then    'create sheet if needed
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
    Else                                                     'clear sheet if it exists
        Sheets(MyArr(i)).Move After:=Sheets(Sheets.Count)
        Sheets(MyArr(i)).Cells.Clear
    End If
    
    ws.Range("A1:Z" & LR).Copy
    Sheets(MyArr(i)).Range("A1").PasteSpecial xlPasteAll
    ws.Range("A1:Z1").AutoFilter Field:=vCol
    MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
    Sheets(MyArr(i)).Columns.AutoFit
Next i

'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

Att

Alexandre,

Fiz a adaptação do código e consegui fazer filtrar e criar planilhas dentro da mesma pasta de trabalho com nome de cada chefia!!!

Para melhor o trabalho gostaria de poder usar um código (MACRO) para gerar no diretorio C: uma pasta "CHEFIA" com cada planilha de chefia separada para poder enviar a todos eles por email o seu quadro de funcionarios....

Não entendi direito. Como assim filtrar? No caso, você que escolhe o nome da chefia e depois criar uma nova pasta de trabalho com esse nome?
Como você planeja filtrar? Através de um formulário, digitando o nome da chefia e automaticamente criando a pasta de trabalho?

PFarias,

Fiz a adaptação do código e consegui fazer filtrar e criar planilhas dentro da mesma pasta de trabalho com nome de cada chefia!!!

Para melhorar o trabalho gostaria de poder usar um código (MACRO) para gerar no diretorio C: uma pasta "CHEFIA" com cada pasta de trabalho de chefia separada.

Boa tarde elvanio

Movi teu tópico para a sala adequada que é VBA & Macros, pois você postou num local exclusivo para Fórmulas e funções.

Por enquanto vou deixar sendo mostrado nos dois locais.

[]s

Patropi - Moderador