VBA, Advanced filter workbook, populate into common columns across worksheets

Question

I have workbook A with many columns and headers, I would like to separate this data and populate into workbook B based on header name(workbook B has 4 sheets of different pre populated column headers)

1) Workbook A (many columns), filter for all its unique values in col 'AN' (ie. col AN has 20 unique values but ~3000 rows each for each unique set).

2) There is workbook B, with pre populated columns in 4 sheets, not all are the same headers as in workbook A. Here is where the unique values from col AN from workbook A with their respective records will be populated, one after the other.

The goal here is to populate these 4 sheets with data from Workbook A, sorting by each unique column AN value, with its records into the prepopulated workbook B.

This code so far just filters my main 'AN' column uniquely and just gets unique values, I need unique values along with records.

Sub Sort()


Dim wb As Workbook, fileNames As Object, errCheck As Boolean
    Dim ws As Worksheet, wks As Worksheet, wksSummary As Worksheet
    Dim y As Range, intRow As Long, i As Integer

Dim r As Range, lr As Long, myrg As Range, z As Range
    Dim boolWritten As Boolean, lngNextRow As Long
    Dim intColNode As Integer, intColScenario As Integer
    Dim intColNext As Integer, lngStartRow As Long
    Dim lngLastNode As Long, lngLastScen As Long


                                 ' Finds column AN , header named 'first name'
                intColScenario = 0
                On Error Resume Next
                intColScenario = WorksheetFunction.Match("First name", .Rows(1), 0)
                On Error GoTo 0

                If intColScenario > 0 Then
                     ' Only action if there is data in column E
                    If Application.WorksheetFunction.CountA(.Columns(intColScenario)) > 1 Then
                       lr = .Cells(.Rows.Count, intColScenario).End(xlUp).Row


                         ' Copy unique values from the formula column to the 'Unique data' sheet, and write sheet & file details
                        .Range(.Cells(1, intColScenario), .Cells(lr, intColScenario)).AdvancedFilter xlFilterCopy, , r, True
                        r.Offset(0, -2).Value = ws.Name
                        r.Offset(0, -3).Value = ws.Parent.Name



                         ' Delete the column header copied to the list
                        r.Delete Shift:=xlUp
                        boolWritten = True
                    End If
                End If


                 'I need to take the rest of the records with this though. 

' Reset system settings
With Application
   .Calculation = xlCalculationAutomatic
   .ScreenUpdating = True
   .Visible = True
End With
End Sub

Adding sample pictures

Workbook A sample, I want to unique filter the 'job column' to get all like records together:

Workbook sample B, Sheet 1 (note there will be multiple sheets). As you can see workbook A has been sorted by the 'job' column.

Answer 1

you could use the following code:

edited to account for workbook "B" worksheets headers in row 2 (instead of row 1 as per OP example)

Option Explicit

Sub main()
    Dim dsRng As Range
    Dim sht As Worksheet
    Dim AShtColsList As String, BShtColsList As String

    Set dsRng = Workbooks("A").Worksheets("ShtA").Range("A1").CurrentRegion '<--| set your entire data set range in workbook "A" worksheet "ShtA" (change "A" and "ShtA" to your actual names)
    dsRng.Sort key1:=dsRng.Range("AN1"), order1:=xlAscending, Header:=xlYes '<--| sort data set range on its 40th column (which is "AN", beginning it from column "A")

    With Workbooks("B") '<--| refer "B" workbook
        For Each sht In .Worksheets '<--| loop through its worksheets
            GetCorrespondingColumns dsRng, sht, AShtColsList, BShtColsList '<--| build lists of corresponding columns indexes in both workbooks
            CopyColumns dsRng, sht, AShtColsList, BShtColsList '<--| copy listed columns between workbooks
        Next sht
    End With
End Sub

Sub GetCorrespondingColumns(dsRng As Range, sht As Worksheet, AShtColsList As String, BShtColsList As String)
    Dim f As Range, c As Range
    Dim iElem As Long

    AShtColsList = "" '<--| initialize workbook "A" columns indexes list
    BShtColsList = "" '<--| initialize workbook "B" current sheet columns indexes list
    For Each c In Sht.Rows(2).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through workbook "B" current sheet headers in row 2     *******
        Set f = dsRng.Rows(1).Find(what:=c.value, lookat:=xlWhole, LookIn:=xlValues) '<--| look up data set headers row for workbook "B" current sheet current column header
        If Not f Is Nothing Then '<--| if it's been found ...
            BShtColsList = BShtColsList & c.Column & "," '<--| ...update workbook "B" current sheet columns list with current header column index
            AShtColsList = AShtColsList & f.Column & "," '<--| ...update workbook "A" columns list with corresponding found header column index
        End If
    Next c
End Sub

Sub CopyColumns(dsRng As Range, sht As Worksheet, AShtColsList As String, BShtColsList As String)
    Dim iElem As Long
    Dim AShtColsArr As Variant, BShtColsArr As Variant

    If AShtColsList <> "" Then '<--| if any workbook "B" current sheet header has been found in workbook "A" data set headers
        BShtColsArr = Split(Left(BShtColsList, Len(BShtColsList) - 1), ",") '<--| build an array out of workbook "B" current sheet columns indexes list
        AShtColsArr = Split(Left(AShtColsList, Len(AShtColsList) - 1), ",") '<--| build an array out of workbook "A" corresponding columns indexes list
        For iElem = 0 To UBound(AShtColsArr) '<--| loop through workbook "A" columns indexes array (you could have used workbook "A" corresponding columns indexes list as well)
            Intersect(dsRng, dsRng.Columns(CLng(AShtColsArr(iElem)))).Copy Sht.Cells(2, CLng(BShtColsArr(iElem))) '<--| copy data set current column into workbook "B" current sheet corresponding column starting from row 2     *******  
        Next iElem
    End If
End Sub

and should really need to have each unique name rows set in workbook "B" sheets separated by a blank row, you can write a quite simple SubSeparateRowsSet() and call it right after CopyColumns() call in main()