Paste values as many time as there are filled rows bellow

I've been trying to find a solution to the following problem for a week but couldn't find anything...

Here is the point ; I've got three different worksheets in my workbook;

• worksheets("Board")
• worksheets("reference")
• worksheets("FinalBoard")

In worksheets("Board") there are multiple column filled with datas with differents headers. I could do a code that paste each datas bellow in sheets("FinalBoard") one bellow the other only if those headers begin by the value "Fruit".

=>worksheets("Board")

A	B	C	D
Fruit-1	Fruit-2	Fruit-3	Vege-1
x	x	x	Y
x	x	x	Y

here is my code;

Sub test()

Worksheets("FinalBoard").Activate
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String

'~~> Setting sheets
Set wsInput = Sheets("Board")
Set wsOutput = Sheets("FinalBoard")

With wsInput
    '~~> Find last column in Row 2
    lCol = .Cells(2, .columns.Count).End(xlToLeft).column
    
    '~~> Loop through columns
    For i = 1 To lCol
        '~~> Check for my criterias
        If .Cells(2, i).Value2 Like "Fruit*" Then
            '~~> Get column name
            Col = Split(.Cells(, i).Address, "$")(1)
            
            '~~> Get the last row in that column
            lRowInput = .Range(Col & .rows.Count).End(xlUp).row
            
            '~~> Find the next row to write to
            If lRowOutput = 0 Then
                lRowOutput = 2
            Else
                lRowOutput = wsOutput.Range("B" & wsOutput.rows.Count).End(xlUp).row + 1
            End If
            
            '~~> Copy all datas bellow each headers
            .Range(Col & "3:" & Col & lRowInput).Copy _
            wsOutput.Range("B" & lRowOutput)
        End If
      Next i

End With End Sub

However, the problem is here I'd like to add an extra condition. During this process, if each of these headers match with a cell contained in a list of words in worksheets("reference") then copy the value beside that cell(located in column "B") and paste it in worksheets("Final Board") in column("A").

=>worksheets("reference") ;

A	B
Fruit-1	N01
Fruit-2	N02
Fruit-3	N03
Fruit-4	N04

worksheets("FinalBoard") ; | A | B | | -------- | -------------- | | Code | X VALUES | | N01 | x | | N02 | x| |N03|x|

As soon as I run my code, nothing happens; no message, no error. I'd also like to insert the following code in the previous I showed you to ease the process and not run this macro again!

Here is it:

    Dim wsTEST1, wsTEST2, wsTEST3 As Worksheet
    Dim lCol As Long
    Dim i, j, e As Long
    Dim Col As String
    Dim cell As Range
    Dim lastlineRef, lastlineDistrib, lastlineResult As Long
  
    
    '~~>  Declaration
    Set wsTEST1 = Sheets("Board")
    
    Set wsTEST2 = Sheets("Reference")
    
    
    Set wsTEST3 = Sheets("FinalBoard")
    
 
   
    With wsTEST1
        
        '~~> loop through columns ( declaration)
        lCol = .Cells(2, .columns.Count).End(xlToLeft).column
        lastlineRef = Worksheets("Reference").Range("A" & rows.Count).End(xlUp).row
        lastlineResult = Worksheets("FinalBoard").Range("A" & rows.Count).End(xlUp).row
    
        '~~> loop through columns
        For i = 1 To lCol 'unti last column
            '~~>  research criterias
            If .Cells(2, i).Value Like "Fruit*" Then
                For e = 1 To lastlineResult
                    
                    
                    If wsTEST1.Cells(2, i).Value = Worksheets("Reference").Range("A" & i) Then
                        Worksheets("Reference").Range("A" & e).Offset(, 1).Copy Worksheets("FinalBoard").Range("A" & e)
                     End If
                     
                Next e
            End If
        Next i
        
    End With
end sub

I feel like I'm so close to find the correct code... I'd heavily appreciate your help once again ! :)