Option Explicit
Sub Liste()
Dim WsCurr As String, WsDest As String, CelIni As String
Dim CelRef As Range, CelCarton As Range, ColDest As Long, LigDest As Long, TotRef
WsCurr = ActiveSheet.Name 'Onglet des données
WsDest = Sheets.Add.Name 'Onglet ajouté pour la liste : à adapter éventuellement
Sheets(WsCurr).Activate
CelIni = "E4" '"A1" 'Cellule initiale des données : à adapter
ColDest = Range(CelIni).Column
TotRef = 0
For Each CelRef In Range(Range(CelIni).Offset(1, 0), Range(CelIni).End(xlDown))
Sheets(WsDest).Cells(CelRef.Row, ColDest).Value = CelRef.Value
ColDest = ColDest + 1
For Each CelCarton In Range(Cells(Range(CelRef.Address).Row, Range(CelIni).Column + 1), Cells(CelRef.Row, Range(CelIni).End(xlToRight).Column))
If CelCarton.Value > 0 Then
Sheets(WsDest).Cells(CelCarton.Row, ColDest).Value = Cells(Range(CelIni).Row, CelCarton.Column).Value & " : " & CelCarton.Value
TotRef = TotRef + CelCarton.Value
ColDest = ColDest + 1
End If
LigDest = CelCarton.Row
Next CelCarton
Sheets(WsDest).Cells(LigDest, ColDest).Value = "Total : " & TotRef
ColDest = Range(CelIni).Column
TotRef = 0
Next CelRef
End Sub