VBA Macro Trop dur !! Help :)

Sub PrePOMacro()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual

Dim fichier, fichierGSCM, fichiervaleur, PrePO, PrePO2, GSCM, tabvaleur, tabvaleur2, jour As String
Dim semainecherchee1, semainecherchee2, valeurcherchee1, valeurcherchee2, valeurremplacee1, valeurremplacee2 As String
Dim i, j, k, l, m, n, o As Long
Dim Extract As Worksheet

'Message de confirmation de lancement de la macro
If MsgBox("Effectuer la mise à jour PrePO ?", vbYesNo + vbQuestion, "Demande de confirmation") = vbYes Then

PrePO = ActiveWorkbook.Name

'Sélectionner le fichier GSCM
ChDrive ("S")
ChDir "S:\fichier"
fichierGSCM = Application.GetOpenFilename("Date,*.xls;*.xlsx", , "Sélectionner l'extraction GSCM")
Workbooks.OpenText Filename:=fichierGSCM
fichierGSCM = ActiveWorkbook.Name

'--------------------------------------------------

Windows(PrePO).Activate
'Onglet SAP, supprimer l'ancienne extract
Sheets("Extract").Select
On Error Resume Next
        Sheets("Extract").ShowAllData
        On Error GoTo 0
    Range("A1:AR1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    

    
Windows(PrePO).Activate
Sheets("Extract").Select
On Error Resume Next
        Sheets("Extract").ShowAllData
        On Error GoTo 0

    'Extract GSCM, mise en plage du tableau
    Columns("A:A").Select
    Columns("I:J").Select
    Columns("AJ:AR").Select
    Selection.Delete Shift:=xlToLeft
    
    Rows("1:1").Select
    Selection.Delete Shift:=xlToLeft
    
    Columns("A:A").Select
    Columns("C:E").Select
    Columns("I:I").Select
    Columns("K:Q").Select
    Columns("S:AG").Select
    Selection.Delete Shift:=xlToLeft
    
    
    Columns("BU:BV").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    
    Columns("H:H").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    
    
        
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "SEF Request"
    
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Comments"
    
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Factory"
    
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "X"
    
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Early Production"
    
'Mettre TV en colonne B
    
Windows(PrePO).Activate
    Sheets("Extract").Select
    Range("B2:B2").AutoFill Destination:=Range("B2:B" & Range("B65536").End(xlUp).Row)
    


 
 'Mettre en chiffre

Range("K2:K65536").Select
 Range("K2:K" & Range("A65536").End(xlUp).Row).FillDown
    ActiveWindow.SmallScroll Down:=-65536
    
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart
    Selection.NumberFormat = "0"



    
' Mettre TV dans colonne

derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:B65536").Select
    ActiveCell.FormulaR1C1 = "TV"
    
    Range("B2").Select
    Range("B2:B" & (derniereLigne) & "").Select

    Selection.FillDown
    Columns("B:B").Select
    Selection.Copy

'filte croissant des données

    Range("A1:K1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Extract").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Extract").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Extract").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

    
' RechercheV

vDerligneSuc = Cells(Rows.Count, 1).End(xlUp).Row
    Range("I2:I65536").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Palettisation!C[-8]:C[20],29,FALSE)"


    
    Range("I2").Select
    Range("I2:I" & (vDerligneSuc) & "").Select

    Selection.FillDown
    Columns("I:I").Select
    Selection.Copy
    


        End With
    End If



End Sub