Sub MiseEnForme()
Dim TabInit() As Variant
Dim TabFinal() As Variant
With Sheets("Test")
TabInit = .UsedRange.Value
NbLigneFinal = WorksheetFunction.CountA(.Range("A:A"))
End With
For i = LBound(TabInit, 1) To UBound(TabInit, 1)
If TabInit(i, 1) <> "" Then
nb = 1
Else
nb = nb + 1
NbMax = WorksheetFunction.Max(NbMax, nb)
End If
Next i
ReDim TabFinal(1 To NbLigneFinal, 1 To NbMax + 3)
indL = 0
indC = 1
For i = LBound(TabInit, 1) + 1 To UBound(TabInit, 1)
If TabInit(i, 1) <> "" Then
indL = indL + 1
indC = 1
For j = LBound(TabInit, 2) To UBound(TabInit, 2)
TabFinal(indL, indC) = TabInit(i, j)
indC = indC + 1
Next j
Else
TabFinal(indL, indC) = TabInit(i, 4)
indC = indC + 1
End If
Next i
With Sheets("Resultat")
.Range("A2").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
.Range("A2").Resize(UBound(TabFinal, 1)).NumberFormat = "0"
End With
End Sub