Bonjour Nowhereman, bonjour le forum,
Peut-être comme ça :
Sub Macro1()
Dim T1 As Variant 'déclare la variable T1 (Tableau de l'onglet 1)
Dim T2 As Variant 'déclare la variable T2 (Tableau de l'onglet 2)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer '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)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Feuil3.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes valeurs dans l'onglet O3
T1 = Feuil1.Range("A1").CurrentRegion 'définit la tableau de l'onglet 1, T1
T2 = Feuil2.Range("A1").CurrentRegion 'définit la tableau de l'onglet 2, T2
K = 1 'initialise la variable K
For I = 2 To UBound(T1, 1) 'boucle 1 : sur toutes les lignes I du tableau T1 (en partant de la seconde)
For J = 2 To UBound(T2, 1) 'boucle 2 : sur toutes les lignes J du tableau T2 (en partant de la seconde)
If T1(I, 1) = T2(J, 1) Then 'condition : si la donnée ligne I colonne 1 de T1 est égale a la donnée ligne J colonne 1 de T2
ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes K colonnes)
For L = 1 To 3 'boucle 3 : sur toutes les colonnes L du tableau T1
TL(L, K) = T1(I, L) 'récupère dans la ligne L du tableau TK la valeur en colonne L du tableau T1 (=> Transposition)
Next L 'prochaine colonne de la boucle 3
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'renvoie dans A2 redimensionnée de l'onglet O3 le tableau TL transposé
Feuil3.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub