Couper coller en boucle avec condition

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (onglet Source)
Dim D As Worksheet 'déclare la variable D (onglet Destination)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément)
Dim LD As Long 'déclare la variable LD (Ligne du Début)
Dim LF As Long 'déclare la variable LF (Ligne de Fin)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim DC As Integer 'déclare la variable DC (DéCalage)

Set S = Sheets("Source") 'définit l'onglet source S (à adapter)
Set D = Sheets("Destination") 'définit l'onglet destination D (à adapter)
Set PL = S.Range("A1") 'définit (initialise) la plage PL
DL = S.Cells(Application.Rows.Count, 9).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 9 (=I) de l'onglet S
TC = S.Range("A4:P" & DL) 'définit le tableau de cellules TC

'cette première boucle va supprimer les ligne vides
For I = 1 To UBound(TC, 1) 'boucle sur toutes les ligne I du tableau de cellules TC
    If Application.Sum(Application.Index(TC, I)) = 0 Then 'condition : si la somme de la ligne vaut 0
        'définit la plage PL (la ligne I+3 si PL ne contient qu'une seule cellule, sinon, l'union de PL et de la ligne I+3)
        Set PL = IIf(PL.Cells.Count = 1, Rows(I + 3), Application.Union(PL, Rows(I + 3)))
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
PL.Delete 'efface la plage PL (supprime les lignes vides)

DL = S.Cells(Application.Rows.Count, 9).End(xlUp).Row 'redéfinit la dernière ligne éditée de la colonne 9 (=I) de l'onglet S
TC = S.Range("A4:P" & DL) 'redéfinit le tableau de cellules TC
For I = 1 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC
    If TC(I, 1) <> "" Then 'condition : si la valeur ligne I colonne 1 de TC n'est pas vide
        Set DEST = D.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        LD = I + 3 'définit la ligne de début LD
        LF = S.Cells(I + 3, 1).End(xlDown).Row - 1 'définit la ligne de fin LF
        If LF > DL Then LF = DL 'si LF est supérieur à DL, alors LF devient DL
        NL = LF - LD 'définit le nombre de ligne NL
        S.Cells(I + 3, 1).Copy DEST 'copie la cellule ligne I+3, colonne 1 dans DEST
        S.Cells(I + 3, 4).Resize(1, 4).Copy DEST.Offset(0, 1) 'copie les cellules ligne I+3 colonne 4 à 7 dans DEST décalée d'une colonne à droite
        For j = 1 To NL 'boucle 2 : de 1 au nombre de ligne NL
            DC = j * 7 + (j - 3) 'définit le décalage DC
            S.Cells(I + 3 + j, 9).Resize(1, 8).Copy DEST.Offset(0, DC) 'copie les cellules de la ligne et les colle dans DEST décalée de DC colonnes à droite
        Next j 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
End Sub

• Pourquoi il y a-t-il encore des ligne masquées ? Faudra-t-il toujours commencer à la ligne 35 ou bien est-ce aléatoire ?
• Les lignes vides du premier fichier ont disparues. Cela signifie-t-il qu'il n'y en aura plus ?

Sub Macro1()
Dim deb As Single 'déclare la variable deb (début du chronomètre)
Dim S As Worksheet 'déclare la variable S (onglet Source)
Dim T As Worksheet 'déclare la variable T (onglet Trame à Utiliser)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim LD As Long 'déclare la variable LD (Ligne de Début)
Dim LF As Long 'déclare la variable LF (Ligne de Fin)
Dim NL As Byte 'déclare la variable NL (Nombre de Lignes)
Dim fin As Single 'déclare la variable fin (fin du chronomètre)

deb = Timer 'lance le chronomètrage
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Sheets("Source").Copy After:=Sheets("Source") 'fait une copie de l'onglet Source (cette copie sera supprimée à la fin de la macro)
Set S = Sheets("Source (2)") 'définit l'onglet S (la copie)
Set T = Sheets("Trame à utiliser") 'définit l'onglet T (à adapter)
S.Rows("1:5").Delete 'supprime les 5 premières lignes de l'onglet S (à adapter)
S.Range("B:B,C:C,H:H").Delete 'supprime les colonne B, C et H de l'onglet S
DL = S.Cells(Application.Rows.Count, 6).End(xlUp).End(xlUp).Row 'définit la dernière ligne contenant des données dans la colonne 6 (=F) de l'onglet S
S.Rows(DL + 1 & ":" & Application.Rows.Count).Delete 'supprime toutes les lignes en dessous de la dernière ligne DL
S.Columns(1).Insert 'insère un colonne avant les données
Set PL = S.UsedRange 'définit la plage PL
Set PL = PL.Offset(0, -1).Resize(PL.Rows.Count, PL.Columns.Count + 1) 'redéfinit la plage PL (en inclunant la 1ère colonne)

'*******************************
'suppression des lignes inutiles
'*******************************
For I = DL To 1 Step -1 'boucle inversée de la dernière ligne DL à la première
    'si le nombre de données contenues dans la ligne est nul, supprime la ligne et va à l'étiquette "suite"
    If Application.WorksheetFunction.CountA(PL.Rows(I)) = 0 Then S.Rows(I).Delete: GoTo suite
    'condition : si le nombre de données contenues dans la ligne est égal à un
    If Application.WorksheetFunction.CountA(PL.Rows(I)) = 1 Then
        S.Cells(I, 2).Copy Cells(I + 1, 1) 'coupe la valeur ligne I colonne 2 (=B) et la colle dans la ligne en dessous, colonne 1 (=A)
        S.Rows(I).Delete 'supprime la ligne
        GoTo suite 'va à l'étiquette "suite"
    End If 'fin de la condition
    'si la valeur en ligne I colonne 3 (=C) est égale à "Debtor Total", supprime la ligne
    If S.Cells(I, 3).Value = "Debtor Total" Then S.Rows(I).Delete
suite: 'étiquette
Next I 'prochaine ligne de la boucle
'*******************************

DL = S.Cells(Application.Rows.Count, 7).End(xlUp).Row 'redéfinit la dernière ligne éditée DL de la colonne 6 (=F) de l'onglet S
For I = 1 To DL 'boucle 1 : de 1 à DL
    Set DEST = T.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    'définit la valeur de DEST (la valeur de la cellule ligne I, colonne 1 (=A) de l'onglet S si elle n'est pas vide
    'sinon, la valeur de la ligne au-dessus colonne 1 (=A) de l'onglet T
    DEST.Value = IIf(S.Cells(I, 1).Value <> "", S.Cells(I, 1).Value, DEST.Offset(-1, 0))
    LD = I 'définit la ligne de début LD
    LF = S.Cells(I, 2).End(xlDown).Row - 1 'définit la ligne de fin LF
    If LF > DL Then LF = DL 'si LF est supérieur à DL, alors LF devient DL (pour la dernière ligne)
    NL = LF - LD 'définit le nombre de lignes NL
    For J = 1 To NL 'boucle 2 : de 1 au nombre de ligne NL
        S.Cells(I, 2).Resize(1, 5).Copy DEST.Offset(0, 1) 'copie la première partie des données
        DC = J * 7 + (J - 2) 'définit le décalage DC
        'copie les données de la série les colle dans DEST décalée de DC colonnes à droite
        S.Cells(I + J, 7).Resize(1, 6).Copy DEST.Offset(0, DC)
    Next J 'prochaine ligne de la boucle 2
    I = I + NL 'redéfinit I
Next I 'prochaine ligne de la boucle 1
Application.DisplayAlerts = False 'masque les messages Excel
S.Delete 'supprime l'onglet S (la copie de l'onglet Source)
Application.DisplayAlerts = True 'affiche les messages Excel
Application.ScreenUpdating = True 'Affiche les rafraîchissements d'écran
fin = Timer - deb 'arrêtre le chronométrage
MsgBox "Données transférées en " & fin & " seconde !" 'message
End Sub

S.Cells(I + J, 7).Resize(1, 6).Copy DEST.Offset(0, DC)

S.Cells(I + J, 7).Resize(1, 8).Copy DEST.Offset(0, DC)