Code VBA excel : Copier/coller des données selon critère

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim OD As Worksheet 'déclare la variable OD (Onglet de Destinbation)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion  'définit le tableau des valeurs TV
DL = UBound(TV, 1) 'définit la dernière ligne DL du tableau des valeurs TV
DC = UBound(TV, 2) 'définit la dernière colonne DC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données ligne I colonne 1 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des données du dictionnaire I sans doublons
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
    K = 1 'initialise la variable K
    For I = 2 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si la données ligne I colonne 1 de TV est égale à l'élément J du tableau temporaire TMP
            ReDim Preserve TL(1 To DC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To DC 'boucle 3 : sur toutes les colonnes de TV (ou toutes les lignes de TL)
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la données en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle (ou prochaine ligne)
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    Select Case K 'agit en fonction de K
        Case 2 'si K vaut 2 (une seule occurrence trouvée)
            Set OD = Worksheets("Feuil2") 'définit l'onglet de destination OD
        Case 3 'si K vaut 3 (deux occurrences trouvées)
            Set OD = Worksheets("Feuil3") 'définit l'onglet de destination OD
        Case 4 'si K vaut 4 (trois occurrences trouvées)
            Set OD = Worksheets("Feuil4") 'définit l'onglet de destination OD
        Case 5 'si K vaut 5 (quatre occurrences trouvées)
            Set OD = Worksheets("Feuil5") 'définit l'onglet de destination OD
        Case 6 'si K vaut 6 (cinq occurrences trouvées)
            Set OD = Worksheets("Feuil6") 'définit l'onglet de destination OD
        Case Else 'tous les autres cas
            Set OD = Worksheets("Feuil7") 'définit l'onglet de destination OD
    End Select 'fin de l'action en fonction de K
    OD.Range("A1").Resize(1, DC).Value = Application.Index(TV, 1) 'copie les intitulés de colonnes dans la ligne 1 de l'onglet OD
    Set DEST = OD.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'revoie dans DEST redimensionnée le tableau TL transposé
    Erase TL 'efface le tableau TL
Next J 'prochain élément de la boucle 1
End Sub

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim OD As Worksheet 'déclare la variable OD (Onglet de Destinbation)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set O = Worksheets("Feuil1") 'définit l'onglet O
Application.DisplayAlerts = False 'désactive les message d'Excel
For I = Sheets.Count To 2 Step -1 'boucle sur tous les onglet (en partant du second)
    Sheets(I).Delete 'supprime l'onglet
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'active les message d'Excel
TV = O.Range("A1").CurrentRegion  'définit le tableau des valeurs TV
DL = UBound(TV, 1) 'définit la dernière ligne DL du tableau des valeurs TV
DC = UBound(TV, 2) 'définit la dernière colonne DC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données ligne I colonne 1 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des données du dictionnaire I sans doublons
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
    K = 1 'initialise la variable K
    For I = 2 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si la données ligne I colonne 1 de TV est égale à l'élément J du tableau temporaire TMP
            ReDim Preserve TL(1 To DC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To DC 'boucle 3 : sur toutes les colonnes de TV (ou toutes les lignes de TL)
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la données en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle (ou prochaine ligne)
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    On Error Resume Next 'gestio des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Worksheets(K - 1 & " fois") 'définit l'onglet OD
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute une onglet en dernière position
        ActiveSheet.Name = K - 1 & " fois" 'renomme l'onglet
        Set OD = ActiveSheet 'définit l'onglet OD
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    OD.Range("A1").Resize(1, DC).Value = Application.Index(TV, 1) 'copie les intitulés de colonnes dans la ligne 1 de l'onglet OD
    Set DEST = OD.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'revoie dans DEST redimensionnée le tableau TL transposé
    Erase TL 'efface le tableau TL
Next J 'prochain élément de la boucle 1
'tri des onglets
For I = 2 To Sheets.Count 'boucle 1 : sur tous les onglets (en partant du second)
    For K = 2 To Sheets.Count 'boucle 2 : sur tous les onglets (en partant du second)
        'si le numéro (avant " fois") de l'onglet I est inférieur au numéro (avant " fois) de l'onglet K, place l'onglet I devant l'onglet K
        If CInt(Split(Sheets(I).Name, " ")(0)) < CInt(Split(Sheets(K).Name, " ")(0)) Then Sheets(I).Move Before:=Sheets(K)
    Next K 'prochain onglet de la boucle 2
Next I 'prochain onglet de la boucle 1
End Sub