Filter Table save as new workbook in same folder

[Alpacino]

Hi all,

I wonder if someone could help.

I have a table in Sheet “Final Filtered” range A1:S510. I like to create a new workbook and filter by manager which are in column G. Sheet “Names” rows 2 to 21 has all the unique managers names I need.

i also like to save the new workbook in the same folder as the current workbook.

Many thanks everyone

Al

 

[DanteAmor]

The result is a single book?
Or do you want a book for each manager?
It is not clear to me. You could give an example of what you have on each sheet and what you expect from the result in the new book.

 

[Alpacino]

Hi

Sorry for not being clear. I have one sheet with all the data. And one sheet(“Names”) in range A2:A21 with all the managers name I need.

I like to create a workbook for each manager with their own data, no one else from the table that is in Sheet(Final Filtered) range (A1:S510).

The column in the table with the managers name is column G.

Hope this makes sense.

Thank you

 

[DanteAmor]

Try this

Sub Test()
  Dim sh As Worksheet, c As Range, ky As Variant, wb As Workbook, wPath As String, lr As Long
  
  Application.SheetsInNewWorkbook = 1
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set sh = Sheets("Final Filtered")
  wPath = ThisWorkbook.Path & "\"
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("G" & Rows.Count).End(xlUp).Row
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("G2:G" & lr)
      .Item(c.Value) = Empty
    Next
    For Each ky In .Keys
      sh.Range("A1").AutoFilter 7, ky
      Set wb = Workbooks.Add
      sh.AutoFilter.Range.Range("A1:S" & lr).Copy Range("A1")
      wb.SaveAs wPath & ky
      wb.Close False
    Next
  End With
  sh.ShowAllData
End Sub

 

[Alpacino]

Many thanks Dante ��

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.