Sub Recuperer()
Dim tablo() As Variant
Dim NomsColonnes() As Variant
p = Selection.Row
q = Selection.Column
Set MonDico = CreateObject("Scripting.Dictionary")
'Sheets("Feuil2").Range("A15:AN9000" & fin).Clear
Sheets("Feuil2").Rows("12:37000").Delete Shift:=xlUp
Dernli = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'variable non utilisée
NomColonneCherchée = "Nom"
With Sheets("Feuil1").Rows(1) 'on cherche dans la ligne 1 de la feuile Feuil1
Set c = .Find(NomColonneCherchée)
If Not c Is Nothing Then
col = c.Column
Else
MsgBox "Pas trouvé le nom "
End If
End With
tablo = Sheets("Feuil1").UsedRange.Value 'on récupère l'ensemble des data de la feuille Feuil1
'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
NomsColonnes = Array("Fruit", "", "", "", "épaisseur", "", "", "chiffre")
For Each Nom In MonDico.keys 'pour chaque nom contenu dans le dictionnaire
If IsEmpty(fin) Then
fin = Selection.Row + 1
Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select '(fin + 3 --> écart 1 ligne entre dupont et tableau
Call entete
Call Cadrage
Else
fin = Sheets("Feuil2").Cells(Rows.Count, Selection.Column).End(xlUp).Row + 5 '+5 --> écart entre chaque tableau
Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select '(fin + 3 --> écart 1 ligne entre dupont et tableau
Call entete
Call Cadrage
End If
Cells(fin + 1, Selection.Column) = UCase(Nom)
Rows(fin + 3).RowHeight = 30 '(fin + 3 --> écart 1 ligne entre dupont et tableau
Cells(fin + 1, Selection.Column).Font.Bold = True
i = 1
For Each intitulé In NomsColonnes
Sheets("Feuil2").Cells(fin + 1, Selection.Column).Offset(2, i - 1) = intitulé '(fin + 1 --> écart 1 ligne entre dupont et tableau
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
For Each intitulé In NomsColonnes
If tablo(1, j) = intitulé Then
If intitulé = "épaisseur" Then
k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = (tablo(i, j) * 100)
Else
k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = tablo(i, j)
End If
End If
Next intitulé
End If
Next j
End If
Next i
x = Cells(Rows.Count, q).End(xlUp).Row
Range(Cells(fin + 4, q), Cells(x, q + UBound(NomsColonnes))).Select '(fin + 3 --> écart 1 ligne entre dupont et tableau
Call Cadrage
Next Nom
Application.ScreenUpdating = True
End Sub