Problème algorithme de séparation des données en onglet

Sub LireFichier3()
Dim SourceRange As Range, TSrc() As Variant, L As Long, LDéb As Long, Onglet As String, FDst As Worksheet, LDst As Long
Set SourceRange = Intersect(Feuil1.[F2:F65536], Feuil1.UsedRange)
TSrc = SourceRange.Value
L = 1
Do: Rem. —— Début onglet
   LDéb = L: Onglet = Split(TSrc(L, 1), "_")(1)
   Do: Rem. —— Détail
      L = L + 1: If L > UBound(TSrc, 1) Then Exit Do
      Loop Until Split(TSrc(L, 1), "_")(1) <> Onglet
Rem. —— Fin onglet
   On Error Resume Next
   Set FDst = Worksheets(Onglet)
   If Err Then Set FDst = Nothing
   On Error GoTo 0
   If FDst Is Nothing Then
      Set FDst = Worksheets.Add(After:=Worksheets(Worksheets.Count))
      FDst.Name = Onglet
      Feuil1.[A1:L1].Copy Destination:=FDst.[A1]
      End If
   LDst = FDst.[F65536].End(xlUp).Row + 1 ' Ligne qui suit le dernier F non vide
   SourceRange.Rows(LDéb).Resize(L - LDéb).EntireRow.Copy Destination:=FDst.Cells(LDst, 1)
   FDst.Columns.AutoFit
   Loop Until L > UBound(TSrc, 1)
End Sub

'Fonction permettant de tester l'existence d'un onglet'
Private Function Onglet_exist(Nom As String) As Boolean
    Dim sh As Worksheet
    Onglet_exist = False
    For Each sh In Sheets
        If sh.Name = Nom Then
            Onglet_exist = True
            Exit For
        End If
    Next
End Function

Sub LireFichier4()

Dim Dl1 As Long ' dernière ligne
Dim Plage As Range
Dim tablo() As String
Dim cellule As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Sheets("Feuil1")
Dl1 = .Range("f" & .Rows.Count).End(xlUp).Row ' dernière ligne
 Set Plage = .Range("F2:F" & Dl1)

For Each cellule In Plage
    If cellule <> "" Then
        tablo = Split(cellule, "_")
        
        If Onglet_exist(tablo(1)) = True Then
            Call copie_ligne(cellule.Row, "Feuil1", tablo(1), "f", "a")
        Else
                Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
                ActiveSheet.Name = tablo(1)
                Call copie_ligne(cellule.Row, "Feuil1", tablo(1), "f", "a")
        End If
    End If
Next cellule

        
    'Revenir au 1er onglet ajouté'
    With Sheets(Sheets("Feuil1").Cells(2, 12).Value)
        .Select
    End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End With
End Sub
Private Sub copie_ligne(nuligne As Long, Feuille_origine As String, Feuille_destination As String, Colonne_pour_ligne As String, Colonne_depart As String)
  Dim £Dl1 As Long
  With Sheets(Feuille_destination)
  £Dl1 = .Range(Colonne_pour_ligne & .Rows.Count).End(xlUp).Row + 1 ' dernière ligne
            
            
            Sheets(Feuille_origine).Rows(nuligne).Copy _
            Destination:=.Range(Colonne_depart & £Dl1)
    End With
End Sub

Sub LireFichier3()


Application.ScreenUpdating = False


Dim LgSource As Range
Dim FDM_tmp() As String, FDM_list() As String
Dim row_nb As Integer
Dim SourceRange As Range
Dim destrange As Range
Dim j As Integer, f As Integer
Dim LDst As Long, FDst As Worksheet

Z1 = False

    With Sheets("Feuil1").Range("F2:F1000").Select
    
    ActiveCell.Interior.ColorIndex = -4142

    'Initialisation du compteur de lignes de longlet source '
    j = 2
    'Initialisation du compteur du tableau dynamique'
    f = 0
      Do While Not (IsEmpty(ActiveCell))
             
        'On récupère le nom de la FDM'
        FDM_tmp = Split(ActiveCell.Value, "_")
          
        'Si l'onglet nexiste pas'
        If Onglet_exist(FDM_tmp(1)) = False Then

            'Nom des onglets dans un tableau dynamique'
            ReDim Preserve FDM_list(0 To f)
            FDM_list(f) = FDM_tmp(1)
            f = f + 1
                
           ' ActiveCell.Interior.ColorIndex = 3
            Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
            ActiveSheet.Name = FDM_tmp(1)
                
            Set destrange = Sheets(FDM_tmp(1)).Range("A" & 2 & ":L" & 2)
    
        'Si longlet existe'
        Else
                                                                                 
            'Tweak pour éviter de parcourir les onglets pour compter le nombre de ligne'
            Set FDst = Worksheets(FDM_tmp(1))
            ' Ligne qui suit le dernier F non vide'
            LDst = FDst.[F65536].End(xlUp).Row + 1
            
            Set destrange = Sheets(FDM_tmp(1)).Range("A" & LDst & ":L" & LDst)
                
        End If
 
        'Processus de copie de chaque ligne'
        Set SourceRange = Sheets("Feuil1").Range("A" & j & ":L" & j)

        SourceRange.Copy destrange
        destrange.Interior.ColorIndex = -4142 'aucune couleur
              
        Sheets("Feuil1").Select
        
        'On incrémente le compteur dans la lecture de la feuille initiale'
        j = j + 1
  
        Selection.Offset(1, 0).Select
        
    Loop
        
    End With

    For f = LBound(FDM_list) To UBound(FDM_list)
        With Sheets(FDM_list(f))
                    
            'Formatage du header du tableau: titres et largeur des colonnes'
            .Select
            .Cells(1, 1).Value = "Chorus Version"
            .Cells(1, 2).Value = "Test type"
            .Cells(1, 3).Value = "Batch"
            .Cells(1, 4).Value = "Item ID"
            .Cells(1, 5).Value = "Test ID"
            .Cells(1, 6).Value = "Test Name"
            .Cells(1, 7).Value = "Test case description"
            .Cells(1, 8).Value = "Total Steps"
            .Cells(1, 9).Value = "Step#"
            .Cells(1, 10).Value = "Step description"
            .Cells(1, 11).Value = "Expected result"
                    
            .Columns("B:B").ColumnWidth = 15
            .Columns("A:A").ColumnWidth = 8.14
            .Columns("D:D").ColumnWidth = 7
            .Columns("E:E").ColumnWidth = 6.14
            .Columns("C:C").ColumnWidth = 7
            .Columns("F:F").ColumnWidth = 26.14
            .Columns("G:G").ColumnWidth = 45.71
            .Columns("J:J").ColumnWidth = 12.29
            .Columns("K:K").ColumnWidth = 24
            .Columns("J:J").ColumnWidth = 23.57

            'Formatage de chaque cellule des onglets : Centré et Retour automatique à la ligne'
            .Cells.Select
            With Selection
                .WrapText = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            With Selection.Font
                .Size = 10
                .Name = "Tahoma"
            End With
            
            'Police utilisée et Couleur du header'
            .Range("A1:L1").Select
            
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent4
                .TintAndShade = 0.399945066682943
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .Name = "Tahoma"
                .FontStyle = "Gras"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            
            'Suppression des colonnes inutiles'
            .Columns("A:D").Delete Shift:=xlToLeft
            
            'Figer les volets jusqu'à la description du test'
            With .Cells(1, 4).Select
                'ActiveWindow.FreezePanes = False
                ActiveWindow.FreezePanes = True
            End With
        End With
    Next f


    'Revenir au 1er onglet ajouté'
    With Sheets(FDM_list(0))
        .Select
    End With
    
    End Sub


'Fonction permettant de tester l'existence d'un onglet'
Private Function Onglet_exist(Nom As String) As Boolean
    Dim sh As Worksheet
    Onglet_exist = False
    For Each sh In Sheets
    
        If sh.Name = Nom Then
            Onglet_exist = True
            Exit For
        End If
    Next
End Function