search header loop through in multiple files if matched then copy entire column and paste into single column

There are multiple Workbooks in a folder and have similar column which Header name is "Name" but in each file column position is chnaged.

I want to search that header in 1st row of each workbook if finds then copy that entire column from multiple workbooks availble in Folder and Paste Unique result (values) into an open workbook where from code is being run.

There is one more thing that i want to extract multiple column by Header please add Array method so i can add more column name. I have attached 2 workbooks and result file

I would appreciate your help.

Sub MultipleSimilarColinto_1()
 
    Dim xFd         As FileDialog
    Dim xFdItem     As String
    Dim xFileName   As String
    Dim wbk         As Workbook
    Dim sht         As Worksheet
    Dim twb         As Workbook
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim desWS As Worksheet
    Dim colArr As Variant
    Dim order As Long
    Dim i As Long

    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWindow.View = xlNormalView
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    Set twb = ActiveWorkbook
    Set desWS = twb.Sheets("Sheet1")
    If xFd.Show Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    Else
        Beep
        Exit Sub
    End If
    xFileName = Dir(xFdItem & "*.xlsx")
    Do While xFileName <> ""
        
        Set wbk = Workbooks.Open(xFdItem & xFileName)
colArr = Array("Name")
        
        For Each ws In wbk.Sheets
            
            If ws.Name <> "Sheet1" Then
            
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            
            For i = LBound(colArr) To UBound(colArr)
                    order = ws.Rows(1).Find("Name", LookIn:=xlValues, lookat:=xlWhole).Column
                    ws.Range(ws.Cells(2, order), ws.Cells(LastRow, order)).Copy desWS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Next i
        End If
            
        Next ws
        wbk.Close SaveChanges:=True
        xFileName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub