XL 2019 récupération automatique de données

Sub Worksheet_Activate()
Dim DL%, DC%, L%, C%, Col%
Application.ScreenUpdating = False
With Sheets("Feuil2")
    DL = .[A10000].End(xlUp).Row
    DC = .Cells(1, Columns.Count).End(xlToLeft).Column
    [A2:Z1000].ClearContents
    For L = 2 To DL
        Col = 0: Cells(L, "A") = .Cells(L, "A")
        For C = 2 To DC
            If Left(.Cells(1, C), 7) = "DOMAINE" Then
                If Col = 0 Then Col = 2 Else Col = Col + 3
                Cells(L, Col) = .Cells(L, C)
            Else
                If Left(.Cells(1, C), 10) = "si domaine" Then
                    If .Cells(L, C) <> "" Then Cells(L, Col + 1) = Cells(L, Col + 1) & "," & .Cells(L, C)
                    If Left(Cells(L, Col + 1), 1) = "," Then Cells(L, Col + 1) = Mid(Cells(L, Col + 1), 2)
                Else
                    If .Cells(L, C) <> "" Then Cells(L, Col + 2) = Cells(L, Col + 2) & "," & .Cells(L, C)
                    If Left(Cells(L, Col + 2), 1) = "," Then Cells(L, Col + 2) = Mid(Cells(L, Col + 2), 2)
                End If
            End If
        Next C
    Next L
End With
Columns.AutoFit: Rows.AutoFit
End Sub

Sub Worksheet_Activate()
On Error GoTo Fin
Application.ScreenUpdating = False
Cells.Clear                                             ' effacement Feuil1
With Sheets("Feuil2")
    DL = .[A10000].End(xlUp).Row                        ' Dernière ligne
    DC = .Cells(3, Columns.Count).End(xlToLeft).Column  ' Dernière colonne
    .[A1].CurrentRegion.Copy
    Range("A1").Select: ActiveSheet.Paste: [A1].Select  ' On duplique la zone utile de Feuil2 vers Feuil1
End With
Dim Tablo(1 To 4)
Tablo(1) = Application.Match("Quel est votre 1er domaine de compétence ?", [3:3], 0)    ' Contient colonne Compétences 1
Tablo(2) = Application.Match("Quel est votre 2ème domaine de compétence ?", [3:3], 0)   ' 2
Tablo(3) = Application.Match("Quel est votre 3ème domaine de compétence ?", [3:3], 0)   ' 3
Tablo(4) = Application.Match("Souhaitez-vous indiquer un domaine d'activité ou de compétence supplémentaire, voire le cas échéant, des fonctions antérieures et/ou transverses ", [3:3], 0) ' Contient colonne de Fin
For N = 1 To 3
    For L = 4 To DL
        For i = Tablo(N) + 1 To Tablo(N + 1) - 2 ' -2 car les colonnes utiles sont 2 colonnes avant le titre suivant
            If Cells(L, i) <> "" Then
                Cells(L, Tablo(N) + 1) = Cells(L, i)
                Exit For
            End If
        Next i
    Next L
Next N
For N = 3 To 1 Step -1 ' On supprime les colonnes
    Range(Cells(1, Tablo(N) + 2), Cells(1, Tablo(N + 1) - 2)).EntireColumn.Delete ' +2 colonne aprés titre à -2 colonnes avant titre suivant
Next N
Application.Goto Reference:=[A1], scroll:=True
Fin:
End Sub