Option Explicit
Dim tablo, tabloR()
Dim i&, j&, k&, ln&, nb&, vb As String
Sub Développer()
tablo = ActiveSheet.Range("A2:G" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
k = 0
For i = 1 To UBound(tablo, 1) '1 à dern ligne'
nb = UBound(Split(tablo(i, 3), "~")) 'nb de ~'
If nb > 0 Then 'si ; >0'
For ln = 0 To nb 'pour chaque ~'
vb = Split(tablo(i, 3), "~")(ln) 'selectionne donnée entre ~'
ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To k + 1) 'dimension 2'
For j = 1 To UBound(tablo, 2) 'j colonne dim2'
tabloR(j, k + 1) = tablo(i, j) 'reprend les info'
Next j
tabloR(3, k + 1) = vb
k = k + 1
Next ln
Else
ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To k + 1)
For j = 1 To UBound(tablo, 2)
If tablo(i, j) = "" Then
tabloR(j, k + 1) = tablo(i, j)
Else
If j = 1 Or j = 5 Or j = 6 Or j = 7 Then
tabloR(j, k + 1) = tablo(i, j) * 1
Else
tabloR(j, k + 1) = tablo(i, j)
End If
End If
Next j
k = k + 1
End If
Next i
Range("A2").Resize(UBound(tabloR, 2), UBound(tablo, 2)) = Application.Transpose(tabloR)
End Sub