Sub Extraction()
Dim dest As Range, P1 As Range, P2 As Range, i&, j%
Set dest = [D2] '1ère cellule du tableau créé
With Range("B10:C" & Rows.Count) 'plage à adapter
Set P1 = .Columns(1).SpecialCells(xlCellTypeConstants)
Set P2 = .Columns(2).SpecialCells(xlCellTypeConstants)
End With
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1, Columns.Count - dest.Column + 1) = "" 'RAZ
For i = 1 To P1.Areas.Count
dest(i) = P1.Areas(i)(1)
dest(i, 2) = P1.Areas(i)(2)
dest(i, 3) = P1.Areas(i)(3)
For j = 1 To P2.Areas(i).Count
dest(i, j + 3) = P2.Areas(i)(j)
Next
Next
Range(dest, Columns(Columns.Count)).Columns.AutoFit 'ajustement largeur
End Sub