Couper/coller

Sub Macro1()
Dim DEB As Single 'déclare la variable DEB (DÉBut)
Dim S As Worksheet 'déclare la variable S (onglet Suivi...)
Dim D As Worksheet 'déclare la variable D (onglet DA...)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Long 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim KA As Long 'déclare la variable KA (incrément Avec)
Dim KS As Long 'déclare la variable KS (incrément Sans)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim TSL() As Variant 'déclare la variable TSL (Tableau Sans les Lignes)
Dim DEST As Range 'déclare la variable DEST (cellue de DESTination)
Dim FIN As Single 'déclare la variable FIN

DEB = Timer 'lance le chronométrage
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set S = Worksheets("SUIVI OT DA") 'définit l'onglet S
Set D = Worksheets("DA SOLDE") 'définit l'onglet D
TV = S.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
KA = 1 'initialise la variable KA
KS = 1 'initialise la variable KS
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    'condition : si la donnée ligne I colonne 8 (=> colonne H) de TV est égale à "CLOTURE" (ou cloture)
    If UCase(TV(I, 8)) = "CLOTURE" Then
        ReDim Preserve TL(1 To NC, 1 To KA) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
        For J = 1 To NC 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
            TL(J, KA) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
        Next J 'prochaine colonne de la boucle
        KA = KA + 1 'incrément KA (ajoute une colonne au tabelau des lignes TL)
    Else 'sinon (si la donnée ligne I colonne 8 (=> colonne H) de TV est différente de "CLOTURE")
        ReDim Preserve TSL(1 To NC, 1 To KS) 'redimensionne le tableau des lignes TL (autant de lignes de TV a de colonnes, K colonnes)
        For J = 1 To NC 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
            TSL(J, KS) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (= Transposition)
        Next J 'prochaine colonne de la boucle
        KS = KS + 1 'incrément K (ajoute une colonne au tableau sans les lignes TSL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If KA > 1 Then 'condition : si KA est supérieure à 1
    Set DEST = D.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la celllule de destination DEST
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If 'fin de la condition
If KS > 1 Then 'condition : si KS est supérieure à 1
    S.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface les le contenu des cellules de l'onget S (sauf la première ligne)
    'renvoie dans A2 redimensionnée de l'onglet S le tableau TSL transposé
    S.Range("A2").Resize(UBound(TSL, 2), UBound(TSL, 1)).Value = Application.Transpose(TSL)
End If 'fin de la condition
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
FIN = Timer - deb 'arrête le chromométrage
MsgBox "Traitement des données effectuées en " & fin & "secondes !" 'message de fin
End Sub