Macro CTRL + F avec variable et export dans une feuille

Private Sub Worksheet_Activate()
Dim T(), LstCr(), Ls As Long, ZCrit As String, N As Long, ET As Boolean, TCrit() As String, Feui As Worksheet, _
   L As Long, CEstOK As Boolean, Z As String, K As Long, TRés(1 To 2, 1 To 8), C As Long
LstCr = FCrit.Range("A1:A" & FCrit.[A65536].End(xlUp).Row).Value
Ls = -1
Application.ScreenUpdating = False
Me.Rows("6:65536").Delete
For N = 1 To UBound(LstCr)
   ZCrit = LstCr(N, 1)
   ET = InStr(ZCrit, ";") > 0: TCrit = Split(UCase(ZCrit), IIf(ET, ";", "*"))
   Ls = Ls + 2
   If Ls > 1 Then Me.Rows("1:3").Copy Destination:=Me.Rows(Ls)
   Me.Rows(Ls + 3).Resize(2).ClearContents
   Me.Cells(Ls, "B").Value = ZCrit
   Ls = Ls + 2
   For Each Feui In Worksheets
      If Feui.Index = Me.Index - 1 Then Exit For
      T = Feui.[M2:U2].Resize(Feui.UsedRange.Rows.Count - 1).Value
      For L = 1 To UBound(T)
         Z = UCase(T(L, 1))
         CEstOK = ET
         For K = 0 To UBound(TCrit)
            If Z Like "*" & TCrit(K) & "*" Then
               If Not ET Then CEstOK = True: Exit For
            ElseIf ET Then
               CEstOK = False: Exit For: End If
            Next K
         If CEstOK Then
            Ls = Ls + 1
            Me.[A4:H5].Copy Me.[A:H].Rows(Ls)
            TRés(1, 1) = T(L, 2): TRés(1, 2) = T(L, 3): For C = 3 To 8: TRés(1, C) = T(L, C + 1): Next C
            TRés(2, 2) = T(L, 1)
            Me.[A:H].Rows(Ls).Resize(2).Value2 = TRés: Me.Cells(Ls, "G").FormulaR1C1 = "=RC[-1]*RC[-2]"
            Ls = Ls + 1: End If
         Next L
      Next Feui
   Next N
End Sub

Private Sub Worksheet_Activate()
Dim T(), LstCr(), Ls As Long, ZCrit As String, N As Long, ET As Boolean, TCrit() As String, Feui As Worksheet, _
    L As Long, CEstOK As Boolean, Z As String, K As Long, TRés(1 To 2, 1 To 10), C As Long
 LstCr = FCrit.Range("A1:A" & FCrit.[A65536].End(xlUp).Row).Value
 Ls = -1
 Application.ScreenUpdating = False
 Me.Rows("6:65536").Delete
For N = 1 To UBound(LstCr)
    ZCrit = LstCr(N, 1)
    ET = InStr(ZCrit, ";") > 0: TCrit = Split(UCase(ZCrit), IIf(ET, ";", "*"))
    Ls = Ls + 2
    If Ls > 1 Then Me.Rows("1:3").Copy Destination:=Me.Rows(Ls)
    Me.Rows(Ls + 3).Resize(2).ClearContents
    Me.Cells(Ls, "B").Value = ZCrit
    Ls = Ls + 2
    For Each Feui In Worksheets
       If Feui.Index = Me.Index - 1 Then Exit For
       T = Feui.[M2:U2].Resize(Feui.UsedRange.Rows.Count - 1).Value
       For L = 1 To UBound(T)
          Z = UCase(T(L, 1))
          CEstOK = ET
          For K = 0 To UBound(TCrit)
             If Z Like "*" & TCrit(K) & "*" Then
                If Not ET Then CEstOK = True: Exit For
             ElseIf ET Then
                CEstOK = False: Exit For: End If
             Next K
          If CEstOK Then
             Ls = Ls + 1
             Me.[A4:J5].Copy Me.[A:J].Rows(Ls)
             TRés(1, 1) = T(L, 2): TRés(1, 2) = T(L, 3): For C = 3 To 10: TRés(1, C) = T(L, C + 1): Next C
             TRés(2, 2) = T(L, 1)
             Me.[A:J].Rows(Ls).Resize(2).Value2 = TRés: Me.Cells(Ls, "G").FormulaR1C1 = "=RC[-1]*RC[-2]"
             Ls = Ls + 1: End If
          Next L
       Next Feui
    Next N
End Sub