Sub test_2()
Dim i&, j&, K&, TReportRw&
Dim DNoms As Object
Dim TData As Variant, TReport As Variant, Tmp As Variant
Set DNoms = CreateObject("Scripting.dictionary")
TReportRw = 1
With Sheets("Base de données")
TData = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(3).Row, .Cells(1, .Columns.Count).End(1).Column))
End With
ReDim TReport(1 To UBound(TData, 1) * UBound(TData, 2), 1 To UBound(TData, 2) + 3)
TReport(1, 1) = "Article"
TReport(1, 2) = "N° Contrat"
TReport(1, 3) = "Nom"
For j = 2 To UBound(TData, 2)
Tmp = Split(Trim(TData(1, j)), " - ")
If Not DNoms.Exists(Tmp(1)) Then DNoms(Tmp(1)) = j + 2
TReport(1, DNoms(Tmp(1))) = Tmp(1)
For i = 2 To UBound(TData, 1)
If TData(i, j) <> "" And TData(i, j) > 0 Then
Tmp = Split(Trim(TData(1, j)), " - ")
TReportRw = TReportRw + 1
TReport(TReportRw, 1) = TData(i, 1)
TReport(TReportRw, 2) = Tmp(0)
TReport(TReportRw, 3) = Tmp(1)
For K = 4 To UBound(TReport, 2)
TReport(TReportRw, K) = 0
Next K
TReport(TReportRw, DNoms(Tmp(1))) = TData(i, j)
End If
Next i
Next j
With Sheets("Ce que je veux faire") 'Adapter le nom de la feuille d'arrivée
.UsedRange.ClearContents
.Cells(1, 1).Resize(TReportRw, DNoms.Count + 3) = TReport
End With
End Sub