Advance Filter Macro from Pivot Table selection

[TBP]

Hi,
Im using this code I found on the web to create separate reports from 1 table and was wonder if I could choose what reports to make from a selection in a pivot table rather than the range "CompanyList".
The pivot table would show all company's in the data and I could just filter out any I didn't require.

Also is there a way to create a sub directory in the current path like "Reports" if there inst already one.

Thanks

Link to example workbook I made up to test
https://onedrive.live.com/redir?resid=6c9e7e05ee40ba3a!127&authkey=!ANJi4GsLu10Nkio&ithint=file%2cxlsm

Option Explicit

Sub CreateSeparateFiles()
    
    Dim cell As Range
    Dim curPath As String
    
    curPath = ActiveWorkbook.Path & "\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each cell In Range("CompanyList")
        [CriteriaField] = cell.Value
        Range("DataAll").AdvancedFilter Action:=xlFilterCopy, _
            criteriarange:=Range("Criteria"), copyToRange:=Range("Extract"), unique:=False
        Range(Range("Extract"), Range("Extract").End(xlDown)).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Range("A1").Select
        ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection, ActiveCell.SpecialCells(xlLastCell)), , xlYes).Name = _
        "Table1"
        Range("A1").Select
        ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium2"
        ActiveWorkbook.SaveAs Filename:=curPath & cell.Value & " In Transit " & Format(Now, "dmmmyyyy") & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWindow.Close
        Range(Range("Extract"), Range("Extract").End(xlDown)).ClearContents
    Next cell
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub