Copier des lignes sur une autre feuille sous conditions

Sub Tranche()
    Dim Plage As Range

    With Worksheets("Source")
        'recherche valeur 7
        R = 7
        Nb = Application.CountIf(.Columns(1), R)    'Nb fois R
        If Nb > 0 Then
            lig = .Columns(1).Find(R, .Cells(1, 1), , xlWhole).Row  'ligne de R
            dercol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'derniere colonne de la feuille
            If lig < 8 Then LD = 1 Else LD = lig - 7        'si lig<7
            Set Plage = .Range(.Cells(LD, 1), .Cells(lig, dercol))      'mise en memoire de la plage de cellules
            Worksheets("Tranche").Range("A7").Resize(6, dercol) = Plage.Value       'copie plage
        End If
        'recherche valeur 6
        R = 6
        Nb = Application.CountIf(.Columns(1), R)
        If Nb > 0 Then
            lig = .Columns(1).Find(R, .Cells(1, 1), , xlWhole).Row
            derlig = .Range("A" & Rows.Count).End(xlUp).Row     'derniere cellule non vide colonne A
            LF = derlig - lig + 1       'taille plage en "longueur
            dercol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            Set Plage = .Range(.Cells(lig, 1), .Cells(derlig, dercol))
            Worksheets("Tranche").Range("A23").Resize(LF, dercol) = Plage.Value
        End If
    End With
End Sub

Sub CopierTranches()

Dim xlWsh1 As Object, xlWsh2 As Object
Dim L As Long
Dim lgDerlig1 As Long
Dim lgDerLig2 As Long

'feuilles du traitement
Set xlWsh1 = Worksheets("Source")
Set xlWsh2 = Worksheets("Tranche")
'récupération du dernier enregistrement de chaque feuille
lgDerlig1 = xlWsh1.UsedRange.Rows.Count
lgDerLig2 = xlWsh2.UsedRange.Rows.Count


With xlWsh1
    'lecture du classeur source à parir de la ligne 1
    For L = 1 To lgDerlig1
        ' fin du traitement si valeur est trouvé en cellule A
        If .Cells(L, 1).Value = "7" Then
            Exit For
        Else
        'copie des lignes de la feuille 1 si cellule A n'est pas vide
            If .Cells(L, 1).Value <> "" Then
                .Rows(L).Copy Destination:=xlWsh2.Range("A7").Rows(lgDerLig2)
                lgDerLig2 = lgDerLig2 + 1
            End If
        End If
    Next L
    
      For L = 8 To lgDerlig1
        ' fin du traitement si valeur est trouvé en cellule A
        If .Cells(L, 1).Value = "6" Then
            Exit For
        Else
        'copie des lignes de la feuille 1 si cellule A n'est pas vide
            If .Cells(L, 1).Value <> "" Then
                .Rows(L).Copy Destination:=xlWsh2.Range("A16").Rows(lgDerLig2)
                lgDerLig2 = lgDerLig2 + 1
            End If
        End If
    Next L
End With
End Sub