Extract_Outputs_by_PName Macro into new workbook for each PName

[ConfusedUnicorn]

Hello,

I am running out of time and my head is spinning, so I hoped I would try this Forum for help.
My VBA skills are pretty bad and this job is to complicated and to big to either use build-in macros, formulas or simply ctr+v

What I need to achieve is:
-Find names from a list in a table and move all rows that contain the searched name into a new workbook, which is saved with a particular name found in another list
-the searched name can be found in one or several columns, but never twice in the same row
-the main table is on sheet1 and the lists on sheet 2

My problems:

- creating a loop to repeat the same procedure for each name and filename in the Name list (
<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Lucida Grande'; color: #000000}</style>[FONT=&quot]Surname1, Firstname1 / [/FONT]OutputExtract_Surname1, Firstname1.xlsx)
- ensuring only the filtered results are copied into the new workbook
- the code needs variables and range declared properly

- an iferror code needs adding too, but its not important right now, and who knows, I might be able to create it myself
- if the code looks a bit messy, it is because I tried to make things a bit clearer

Many thanks guys!

Here is the code from the example data:

'

Option Explicit


Sub Extract_Output()
'
' Extract_Output Macro
' searches for all outputs that have Name in their row and creates new workbook with these outputs


Application.ScreenUpdating = False
Application.EnableEvents = False




Dim lngLastRow As Long
Dim wsAllOutputs As Worksheet, wsAllNames As Worksheet


'saw this done somewhere but not sure if its any use
Dim TableAllOutcomes As ListObject
Dim SearchAndSave As ListObject
Dim x As Long




Set wsAllOutputs = Sheet1
Set wsAllNames = Sheet2






lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


'STEP1 copies Filename in column B, "Filenames", in sheet "wsAllNames" and saves a new file with this name




Range("B2").Select




    ActiveCell.FormulaR1C1 = "OutputExtract_Surname1, Firstname1"
    Workbooks.Add
    
    Range("A1").Select
    
    ActiveWorkbook.SaveAs Filename:= _
        "Macintosh HD:Users:unicorn:Documents:extracted outputs:OutputExtract_Surname1, Firstname1.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
    Windows("GetOutputs.xlsm").Activate
    
    Sheets("wsAllOutputs").Select
    Range("AllOutputs[#Headers]").Select
    Selection.Copy
    Windows("OutputExtract_Surname1, Firstname1.xlsx").Activate
    ActiveSheet.Paste


    
    
        
    
                                                        
'STEP2 copies the first name from list "Names" in A2, worksheet "wsAllNames"
                                                        
    Windows("GetOutputs.xlsm").Activate
    
        'range need to be variable, going from Cell A2 down to last cell in range "Names"
                                                        
         Range("A2").Select
         ActiveCell.FormulaR1C1 = "Surname1, Firstname1"
    


'STEP3 searches for this name in table "TableAllOutputs", on ws1 "wsAllOutputs" Column C "PName1", using the autofilter search field


      Sheets("wsAllOutputs").Select
                
        '"Name" is copied into Autofilter, starting in Field:=3 ("PName1")
                                                         
        'filename is saved with filename from range "Name", Surname1, Firstname1; Surname2, Firstname2; Surname3, Firstname3; etc, needs to be variable
                                                         
        ActiveSheet.ListObjects("AllOutputs").Range.AutoFilter Field:=3, Criteria1 _
                                                             :="Surname1, Firstname1"
                                                             
'STEP4 if name is found, copies all rows where result is found into the new workbook for that name
    
    Range("AllOutputs").Select
    
       'this is selecting the first filter output, whole row, that needs to be variable too?
        Range("A12").Activate


        'variable filename from range "Filename"
    Selection.Copy
    
ActiveSheet.ListObjects("AllOutputs").Range.AutoFilter Field:=3


        Windows("OutputExtract_Surname1, Firstname1.xlsx").Activate
                                                            
    Range("A2").Select
    ActiveSheet.Paste
    
    'goes back to range "Name" to copy the first name again and start searching it in "AllOutputs"
    
    Windows("GetOutputs.xlsm").Activate
    Sheets("wsAllNames").Select
    
        'variable
        ActiveCell.FormulaR1C1 = "Surname1, Firstname1"
        
        
    Sheets("wsAllOutputs").Select
    
        'variable
        
        ActiveSheet.ListObjects("AllOutputs").Range.AutoFilter Field:=4, Criteria1 _
         :="Surname1, Firstname1"
    
    Range("AllOutputs").Select
    
        'variable
        Range("A20").Activate
    
    Selection.Copy
    
        'variable
        Windows("OutputExtract_Surname1, Firstname1.xlsx").Activate
        
        'supposed to be the first blank row underneath last filled row in new workbook
        Range("A4").Select
    
    ActiveSheet.Paste
    
  
     'STEP5 repeats steps 3, 4  (LOOP_1 for Step 3 and 4)
    'if name is not found, looks in next search columns, one by one, until the end of search range (TableAllOutputs, Column C - F), always repeating step 3 if name is found in column before moving on to next column

    
    Windows("GetOutputs.xlsm").Activate
    Sheets("wsAllNames").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Surname1, Firstname1"
    Sheets("wsAllOutputs").Select
    ActiveSheet.ListObjects("AllOutputs").Range.AutoFilter Field:=4
    
   'No results in Range.AutoFilter Field:=5, that's why it is not recorded?
    
    ActiveSheet.ListObjects("AllOutputs").Range.AutoFilter Field:=6, Criteria1 _
        :="Surname1, Firstname1"
    Range("AllOutputs").Select
    Range("A122").Activate
    Selection.Copy
    ActiveSheet.ListObjects("AllOutputs").Range.AutoFilter Field:=6
    
    
    Windows("OutputExtract_Surname1, Firstname1.xlsx").Activate
    Range("A5").Select
    ActiveSheet.Paste
    Range("A1").Select
    


    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    
   'STEP6, sorts extract by column one ascending, saves workbook and close (Loop_2 for steps 1, 2, 3, 4, 5 until last row in range "Names" has been used)
   
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:N5")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

'if an Error occours (ie, name not found, filenaming error), record error in wsAllNames in column "ErrorLog", in the same row as the search name is located and moves on to next step


'opens msgbox at end of routine, before closing workbook, with message "errors recorded", if errors have been recorded, no msgbox if no error occured