Bonjour,
A essayer :
Sub Réorganiser()
Dim T(), num, i%, j%, k%, n%, m&
With Worksheets("Brut")
With .UsedRange
n = .Rows.Count: k = .Columns.Count
End With
For j = 1 To k Step 3
num = IIf(.Cells(3, j + 1) = "", .Cells(3, j), .Cells(3, j + 1))
If num = "" Then num = "Manque num"
For i = 6 To n
If .Cells(i, j) <> "" And .Cells(i, j) <> "Taxon" Then
m = m + 1: ReDim Preserve T(3, m)
T(0, m) = num: T(1, m) = .Cells(i, j)
T(2, m) = .Cells(i, j + 1): T(3, m) = .Cells(i, j + 2)
End If
Next i
Next j
End With
With Worksheets("Résultat")
.UsedRange.ClearContents
With .Range("A1").Resize(m + 1, 4)
.Value = WorksheetFunction.Transpose(T)
.Columns.AutoFit
End With
.Activate
End With
End Sub
Cordialement.