Sub CreerTableau()
Dim c As Range, n As Byte
Application.ScreenUpdating = False
With Feuil2 'CodeName
.[A:A].Replace "Nature", "#N/A", xlWhole
For Each c In .[A:A].SpecialCells(xlCellTypeConstants, 16)
If n = 0 Then c.EntireRow.Copy .[A1]: n = 1
If c.Column = 1 Then
c.CurrentRegion.Columns(1) = c(-1)
c(-1).Resize(3) = ""
End If
Next
.[A1] = "Nom"
.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.[B:B,K:L].Delete
.Columns.AutoFit 'ajustement largeurs
.Rows.AutoFit 'ajustement hauteurs
.[H:I].Replace ",", ".", xlPart 'conversion des textes en nombres
End With
End Sub