How to copy and paste data into n new workbooks based on two filters with VBA?

My goal is to copy and paste data from 1 Master workbook into n separate workbooks.

The user should be able to select a "Desk" in the Master which then triggers the creation of X amount of workbooks for each person in this Desk (each recipient is not not allowed to see the data of others, that's why the data per Desk must be split).

The filter should work on two criterias:

• The 1st criteria is the "Desk". There are 3 options (Desk 1, Desk 2, Desk 3)
• The 2nd criteria is the people assigned to each desk. I hava a mapping table for person per desk in one of the Master sheets

So far I was only able to create a workbook which shows the Desk data, but I need to split this data further for each Person:

Option Explicit

 Sub copy_data()

    Dim count_col As Long
    Dim count_row As Long
    Dim RelationSheet As Worksheet
    Dim AccountSheet As Worksheet
    Dim InstructionSheet As Worksheet
    Dim wb As Workbook, sht As Worksheet
    Dim desk As String
    Dim START_CELL As String

    Set InstructionSheet = Sheet2
    Set RelationSheet = Sheet1
    Set AccountSheet = Sheet3
    desk = InstructionSheet.Cells(14, 3).Text
    START_CELL = "B5"

    Set wb = Workbooks.Add
    Set sht = ActiveSheet
    sht.Name = "RELATION LEVEL"

    With RelationSheet.Range(START_CELL)
        .AutoFilter Field:=4, Criteria1:=desk
        .CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
    End With

    sht.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
    sht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    
    With ActiveWindow
        If .FreezePanes Then .FreezePanes = False
        .SplitColumn = 1
        .SplitRow = 2
        .FreezePanes = True
    End With

    Application.CutCopyMode = False
    RelationSheet.ShowAllData
    RelationSheet.AutoFilterMode = False

   
End Sub

I don't know how to add the second filter to the code to create further workbooks for each person.

In the example below, selecting "Desk 1" and then running the macro (via button) should create 2 separate workbooks; one for Anastasia and one for Rob. The name of each report should combine the desk and person name, e.g. "Desk_1_Anastasia".

If there isn't a desk+person combination, an empty report shall be generated (= copy table header to the report).

Mapping table:

I prepared an Excel with dummy data to illustrate the source data better:

Excel with example data

• Source data is formatted as a table (Insert > Table) in your file. Utilizing ListObject makes it easier to manage.

Microsoft documentation:

ListObject object (Excel)

Option Explicit
Sub copy_data()
    Dim RelationSheet As Worksheet
    Dim AccountSheet As Worksheet
    Dim InstructionSheet As Worksheet
    Dim wb As Workbook, sht, desk As String
    Dim rngLookUp As Range, i As Long, sDesk As String, sPerson As String
    Dim arrData, sFile As String, sPath As String
    sPath = ThisWorkbook.Path & "\"
    Set InstructionSheet = Sheet2
    Set RelationSheet = Sheet1
    Set AccountSheet = Sheet3
    desk = InstructionSheet.Cells(14, 3).Text
    If Len(desk) = 0 Then Exit Sub
    ' load lookup table into an array
    With InstructionSheet.Range("M1").CurrentRegion
        arrData = .Resize(.Rows.Count - 1).Offset(1).Value
    End With
    Application.ScreenUpdating = False
    ' loop through lookup table
    For i = LBound(arrData) To UBound(arrData)
        sDesk = arrData(i, 1)
        If sDesk = desk Then ' match desk
            sPerson = arrData(i, 2)
            ' report workbook name
            sFile = Replace(sDesk, " ", "_") & "_" & sPerson & ".xlsx"
            Set wb = Workbooks.Add
            Set sht = ActiveSheet
            sht.Name = RelationSheet.Name
            With RelationSheet.ListObjects(1)
                If .AutoFilter.FilterMode Then
                    .AutoFilter.ShowAllData
                End If
                ' filter desk and person
                .Range.AutoFilter Field:=4, Criteria1:=sDesk
                .Range.AutoFilter Field:=2, Criteria1:=sPerson
                ' copy filtered table
                .Range.SpecialCells(xlCellTypeVisible).Copy sht.Range("A1")
                .AutoFilter.ShowAllData
            End With
            ' add a new sheet for AccountLevel
            Set sht = wb.Sheets.Add
            sht.Name = AccountSheet.Name
            With AccountSheet.ListObjects(1)
                If .AutoFilter.FilterMode Then
                    .AutoFilter.ShowAllData
                End If
                .Range.AutoFilter Field:=1, Criteria1:=sDesk
                .Range.AutoFilter Field:=2, Criteria1:=sPerson
                .Range.SpecialCells(xlCellTypeVisible).Copy sht.Range("A1")
                .AutoFilter.ShowAllData
            End With
            Application.DisplayAlerts = False
            ' save report, overwrite if exists
            wb.SaveAs sPath & sFile
            Application.DisplayAlerts = True
            wb.Close
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub