split column into multiple files into multiple columns based on another file

hi
I would split column B into files PUR1,PUR2 into multiple columns into column B,C,D,E based on splited data file SEARCH into columns B,C,D . the result should be in first sheet into files PUR1,2 and should replace the data every time run the macro . I put the expected result in both the files in sheet result . I have about five files in the same folder whit the same structure as in PUR1,2

thanks in advance

Is there any reason why you have separate workbooks rather than putting all the data in one workbook with 2 sheets per "PURx"??

See attached

Named range "Key" based on formula in H of "RP"

=D2& " " &E2& " " &F2

in c2 of "PUR1B"

=IFERROR(INDEX(RP!D$2:D$1000,MATCH(PUR1A!$B2,Key,0)),"")

copy across to E

in F2

=IFERROR(INDEX(PUR1A!E$2:E$1000,MATCH(PUR1A!$B2,PUR1A!$B$2:$B$1000,0)),"")

VBA version

Sub Reports(wb As Workbook)

Dim i As Long, j As Long, n As Long, r As Long, c As Long
Dim lastrow As Long, Lastcol As Long
Dim inarr, outarr, BP_Key, Key_Arr
Dim res  As Integer

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

'MsgBox wb.Name

Set ws1 = ThisWorkbook.Worksheets("RP")
 
With ws1  ' Sheet "RP"
    
        lastrow = .Cells(Rows.Count, 3).End(xlUp).Row
        Lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        inarr1 = .Range(.Cells(2, 3), .Cells(lastrow, Lastcol))  ' "RP" data
        
        BP_Key = .Range("key")  ' list of "keys"
    
End With

With wb

    Set ws2 = Worksheets("Report")
    Set ws3 = Worksheets("Result")
    
    With ws2  ' Sheet "Report"
    
        lastrow = .Cells(Rows.Count, 2).End(xlUp).Row
        Lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        Key_Arr = .Range(.Cells(2, 2), .Cells(lastrow, 2))
        inarr2 = .Range(.Cells(2, 1), .Cells(lastrow, Lastcol))
        
    End With
    
    ReDim outarr(1 To UBound(inarr2, 1), 1 To UBound(inarr2, 2))
    
    ws3.Activate ' sheet "Result"
    
    With ws3
        
        For r = 1 To UBound(inarr2, 1)
            res = Application.Match(inarr2(r, 2), BP_Key, 0) ' Match "ID" vs "key"
            If Not IsError(res) Then
                outarr(r, 1) = inarr2(r, 1)
                outarr(r, 2) = inarr1(res, 2)
                outarr(r, 3) = inarr1(res, 3)
                outarr(r, 4) = inarr1(res, 4)
                res = Application.Match(inarr2(r, 2), Key_Arr, 0)
                If Not IsError(res) Then
                    outarr(r, 5) = inarr2(res, 5)  ' Qty
                End If
            End If
            
        Next r
    
    End With
    
    ws3.Range("B2").Resize(UBound(outarr, 1), UBound(outarr, 2)) = outarr
    

End With

End Sub
Sub Loop_Folder()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(fileName:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
     Call Reports(wb)  ' ****** Produce Reports  *******
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Assumes ALL files in the selected folder are to be processed.

Ensure TAB names are consistent (currently "Report" and "Result")