VLOOKUP avec nombre de colonnes qui change

Sub copydata()

    Dim lngCounter As Long
    Dim lngMax As Long
    Dim lngCol As Long
    Dim wksTwo As Worksheet
     'copier de la sheet1 a la sheet2, on copie en valeurs
    Set wksTwo = Worksheets("Sheet2")
     
    wksTwo.Cells.ClearContents
    Worksheets("Sheet3").Cells.ClearContents
    Worksheets("Sheet1").Range("zoneselect").Copy
    wksTwo.Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, skipBlanks:=False, Transpose:=False
     
     ' On enleve les blancs entre la sheet 2 à la sheet3
    wksTwo.Range("A1:BB1").Copy Sheets("Sheet3").Range("B1")
    Sheets("Sheet3").Range("B1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft
    
    Worksheets("Sheet3").Select
    Range("A1:BB1").Select
    Selection.Cut
    Sheets("Sheet3").Select
    Range("B1").Select
    ActiveSheet.Paste
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.Delete shift:=xlToLeft
   
     'On selectionne l'action qui a le plus de dates pour la copier dans la sheet3
    With wksTwo
        For lngCounter = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            If InStr(1, .Cells(1, lngCounter).Value, "FP") > 0 Then
                If .Cells(.Rows.Count, lngCounter).End(xlUp).Row > lngMax Then
                    lngMax = .Cells(.Rows.Count, lngCounter).End(xlUp).Row
                    lngCol = lngCounter
                End If
            End If
        Next lngCounter
         'MsgBox "Greatest length is " & lngMax & " beneath Range " & Cells(1, lngCol).Address(0, 0)
        .Range(.Cells(2, lngCol), .Cells(lngMax, lngCol)).Copy Destination:=Worksheets("Sheet3").Range("A2")
    End With


'Début du VLOOKUP il faudrait le généraliser en fonction du nombre de stocks
Sheets("Sheet3").Select
Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!RC:R[5563]C[1],2,TRUE)"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B5565")
Range("B2:B5565").Select
    
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!R2C2:R5565C3,2,TRUE)"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Sheet2!R2C4:R5565C5,2,TRUE)"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Sheet2!R2C6:R5565C7,2,TRUE)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C5565")
    Range("C2:C5565").Select
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D5565")
    Range("D2:D5565").Select
    
End Sub