Private Sub CommandButton1_Click()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim NC As Byte 'déclare la variable NC (Nombre de Critères)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TC(1 To 6) 'déclare la variable TC (Tableau des Critères)
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 L As Byte 'déclare la variable L (incrément)
Dim NT As Byte 'déclare la variable NT (Nombre de Test)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
ActiveCell.Select 'enlève le focus au bouton
Set OD = Worksheets("Feuil3") 'définit l'onglet destination OD
OD.Range("A7").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données
NC = Application.WorksheetFunction.CountA(OD.Range("A2").Resize(1, 6)) 'définit le nombre de critères NC
If NC = 0 Then Exit Sub 'si aucun critère, sort de la procédure
For I = 1 To 6 'boucle sur les 6 colonnes (de 1 à 6)
TC(I) = OD.Cells(2, I).Value 'alimente le tableau des critères TC avec la valeur en ligne 2 de la boucle
Next I 'prochaine colonne de la boucle
K = 1 'initialise la variable K
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
If Left(O.Name, 10) = "Dispositif" Then 'condition 1 : si le nom de l'onglet commence par "Dispositif"
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs
For J = 1 To 6 'boucle 3 : sur tous les critères du tableau des ctritères TC
If TC(J) <> "" Then 'condition 2 : si le critère n'est pas vide
'si la donnée en ligne I colonne J + 1 de TV est égale au critère TC(J), incrémente le nombre de test NT
If TV(I, J + 1) = TC(J) Then NT = NT + 1
End If 'fin de la condition 2
Next J 'prochain critère de la boucle 3
If NT = NC Then 'condition 3: si le nombre de critères NC est égal au nombre de test NT
ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (auntant de lignes que TV a de colonnes, K colonnes)
For L = 1 To UBound(TV, 2) 'boucle 4 sur toutes les colonnes L du tableau des valeurs TV
TL(L, K) = TV(I, L) 'récupère dans la ligne de TL la donnée en colonne L de TV (=> Transposition)
Next L 'prochaine colonne de la boucle 4
K = K + 1 'incrémente K
End If 'fin de la condition 3
NT = 0 'initialise le nombre de test NT
Next I 'prochaine ligne de la boucle 2
End If 'fin de la condition 1
Next O 'prochain onglet de la boucle 1
'si K est supérieure à 1, envoie dans la cellue A8 redimensionnée, le tableau TL transposé
If K > 1 Then OD.Range("A8").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub
