Bonjour IrAgi, bonjour le forum,
Peut-être comme ça :
Sub ThauTheme()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Set O = Worksheets("Base de données originale ") 'définit l'onglet O (attention il y a un espace à la fin...)
O.Range("D1").Value = "N" 'écrit "N" dans D1
Set PL = O.Range("A1").CurrentRegion 'définit la plage PL
TV = PL 'définit le tabelau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I de TV (en partant de la seconde)
Select Case Cells(I, "A").Interior.ColorIndex 'agit en fonction de la couleur de la cellule ligne I colonne "A"
Case 3 'cas rouge
K = K + 1 'incrémente K
ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
For J = 1 To 3 'boucle 2 : sur les 3 premières colonnes de TV
TL(J, K) = 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 2
TL(4, K) = 1 'récupère la valeur 1 pour le tri final
Case 43 'cas vert
K = K + 1 'incrémente K
ReDim Preserve TL(1 To 4, 1 To K) 'redimenstionne le tableau des lignes TL (4 lignes, K colonnes)
For J = 1 To 3 'boucle 2 : sur les 3 premières colonnes de TV
TL(J, K) = 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 2
TL(4, K) = 2 'récupère la valeur 2 pour le tri final
Case Else 'tous les autres cas
K = K + 1 'incrémente K
ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
For J = 1 To 3 'boucle 2 : sur les 3 premières colonnes de TV
TL(J, K) = 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 2
TL(4, K) = 3 'récupère la valeur 3 pour le tri final
End Select 'fin de l'action en fonction de la couleur de la cellule ligne I colonne "A"
Next I 'prochaine ligne de la boucle
O.Range("A2").Resize(K, 4).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans A2 redimensionnée de l'onglet O
Set PL = PL.Resize(PL.Rows.Count - 1, PL.Columns.Count).Offset(1, 0) 'redéfinit la plage PL (sans la première ligne)
'tri de PL en fonction du nunéro en colonne D puis en fonction de la colonne A
PL.Sort O.Range("D2"), xlAscending, O.Range("A2"), , xlAscending, Header:=xlNo
O.Columns(4).Delete 'supprime la colonne 4 (des numéros)
End Sub