Sub Recuperer()
Application.ScreenUpdating = False
Dim tablo() As Variant
Dim NomsColonnes() As Variant
Set mondico = CreateObject("Scripting.Dictionary")
Sheets("Feuil2").Range("A2:C34").ClearContents
'Sheets("Feuil2").UsedRange.Offset(1, 0).ClearContents 'on efface la feuille 2 Sauf la ligne 1
col = 2 'numéro de la colonne de laquelle on va extraire les éléments SANS doublon --> ici Col B = Col Noms
'si la colonne Noms se déplace:
' soit tu connais sa place et tu remplaces manuellement la valeur de col
' soit tu cherches sa position dans la feuille1
'NomColonneCherchée = "Nom"
'With Sheets("Feuil1").Rows(1) 'on cherche dans la ligne 1 de la feuile 1
' Set c = .Find(NomColonneCherchée)
' If Not c Is Nothing Then
' col = c.Column
' End If
'End With
tablo = Sheets("Feuil1").UsedRange.Value 'on récupère l'ensemble des data de la feuille1
'on récupère la liste des noms sans doublon de la colonne "col" que l'on met dans un dictionnaire
For i = LBound(tablo, 1) + 1 To UBound(tablo, 1) 'lbound+1 pour éviter la ligne d'entete
If tablo(i, col) <> "" Then mondico(tablo(i, col)) = ""
Next i
'cas ou les Intitulés sont saisis dans la feuille --> NomsColonnes est ici un tablo de valeurs
'NbColonnes = Cells(1, Sheets("Feuil2").Columns.Count).End(xlToLeft).Column
'NomsColonnes = Range("A1").Resize(1, Cells(1, Sheets("Feuil2").Columns.Count).End(xlToLeft).Column).Value
'cas ou tu saisis les intitulés directement dans la macro.. (pas le meilleur à mon avis..) NomsColonnes est ici un ARRAY
NomsColonnes = Array("Fruit", "Nombre", "épaisseur")
For Each nom In mondico.keys 'pour chaque nom contenu dans le dictionnaire
fin = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row 'on récupère la dernière ligne de la feuille2
Range("A" & fin + 1) = UCase(nom) 'on place le Nom en majuscule
Range("A" & fin + 1).Font.Bold = True 'et en gras
' For i = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'on recopie la ligne de titre du tablo
' Sheets("Feuil2").Range("A" & fin).Offset(2, i - 2) = tablo(1, i)
' Next i
'dans le cas d'une range, on la parcourt avec un for i..
' For i = LBound(NomsColonnes, 2) To UBound(NomsColonnes, 2) 'on recopie la ligne de titre du tablo
' Sheets("Feuil2").Range("A" & fin).Offset(2, i - 1) = NomsColonnes(1, i)
' Next i
'dans le cas d'un Array, on parcourt avec un for each..
i = 1
For Each intitulé In NomsColonnes
Sheets("Feuil2").Range("A" & fin).Offset(2, i - 1) = intitulé
i = i + 1
Next intitulé
For i = LBound(tablo, 1) To UBound(tablo, 1) 'pour chaque ligne du tablo
If UCase(tablo(i, col)) = UCase(nom) Then 'si on est sur le bon nom
For j = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'pour chaque colonne
If tablo(i, j) <> "" Then 's'il y a quelque chose
'cas du tablo de valeurs
' For k = LBound(NomsColonnes, 2) To UBound(NomsColonnes, 2)
' If tablo(1, j) = NomsColonnes(1, k) Then
' Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = tablo(i, j) 'on le recopie à la bonnen place
' End If
' Next k
'cas du array
For Each intitulé In NomsColonnes
If tablo(1, j) = intitulé Then
k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0)
Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = tablo(i, j)
End If
Next intitulé
End If
Next j
End If
Next i
Next nom
Application.ScreenUpdating = True
End Sub
