Bonjour le fil, bonjour le forum,
En pièce jointe ton fichier modifié avec le code ci-dessous :
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
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)
If Target.Address <> "$E$2" Then Exit Sub 'si le changement a lieu ailleur qu'en E2, sort de la procédure
Range("A6:I" & Application.Rows.Count).ClearContents 'efface d'éventuelles anciennes donnnées
If Target.Value = "" Then Exit Sub 'su E2 est effacée, sort de la procédure
K = 1 'initialise la variable K
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
Select Case O.Name 'agit en fonction du nom de l'onglet
Case "RECHERCHE", "TIROIRS MAGASIN" 'cas "RECHERCHE" et "TIROIRS MAGASIN" (rien ne se passe)
Case Else 'tous les autres cas
DL = O.Range("E" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne E de l'onglet O
If DL > 1 Then 'condition : si Dl est supérieur à 1
TV = O.Range("A2:I" & DL) 'définit le tablau des valeurs TV (les données de A2 à I&DL)
For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
If InStr(1, TV(I, 5), Target.Value, vbTextCompare) <> 0 Then 'condition 2 : si le texte éditée dans E2 est contenu dans la donnée ligne I colonne 5 de TV
ReDim Preserve TL(1 To 9, 1 To K) 'redimensionne le tableau des lignes TL (9 lignes, K colonnes)
TL(1, K) = TV(1, 1) 'récupère dans la ligne 1 le tiroir dans la donnée ligne 1 colonne 1 de TV
For J = 2 To 9 'boucle 3 : sur les 8 dernière lignes de TL (ou colonnes de TV)
TL(J, K) = TV(I, J) 'récupère dans la ligne J colonne K de TL la donnée ligne I colonne J de TV (=transposition)
Next J 'prochaine ligne de la boucle 3
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
End If 'fin de la condition 2
Next I 'prochaine ligne de la boucle 2
End If 'fin de la condition 1
End Select 'fin de l'action en fonction du nom de l'onglet
Next O 'prochain onglet de la boucle 1
'si K est supérieure à un, renvoie dans A6 redimensionnée le tableau TL transposé, sinon, message
If K > 1 Then Range("A7").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) Else MsgBox "Aucune occurrence trouvée !"
End Sub
Le fichier :