Détailler les prix d'une liste

Private Sub CommandButton1_Click()

'p1 = 1re cellule de la liste d'articles (aucune ligne vide !)
Dim p1 As Range, p2 As Range, dPrix As Variant, i As Integer, l As Integer
Dim Tablo As Variant, Tablo2 As Variant

Set p1 = Range("B10")
Set p2 = p1

Application.ScreenUpdating = False

If p1.Count > 1 Then
    MsgBox "Mauvaise plage sélectionnée. Recommencer"
    Exit Sub
End If

ReDim Tablo(1 To 3, 1 To 1)
l = 2
Do Until IsEmpty(p1)
    ReDim Preserve Tablo(1 To 3, 1 To UBound(Tablo, 2) + p1)
    dPrix = p1.Offset(0, 2) / p1.Value
    
    Tablo(1, l) = p1.Offset(0, 0)
    Tablo(2, l) = p1.Offset(0, 1)
    For i = l To UBound(Tablo, 2): Tablo(3, i) = dPrix: Next i
    l = UBound(Tablo, 2) + 1
Set p1 = p1.Offset(1, 0)
Loop

ReDim Tablo2(1 To 3, 1 To UBound(Tablo, 2) - 1)
For i = 1 To UBound(Tablo2, 2)
    Tablo2(1, i) = Tablo(1, i + 1)
    Tablo2(2, i) = Tablo(2, i + 1)
    Tablo2(3, i) = Tablo(3, i + 1)
Next i

p2.Resize(UBound(Tablo2, 2), 3) = Application.Transpose(Tablo2)
Application.ScreenUpdating = True

End Sub