Option Explicit
Sub essai()
Dim Tab_Datas
Set Tab_Datas = CreateObject("scripting.dictionary")
Dim L1, C1, cle, tmp
'-------------------------------------------------------------
' Lecture des données
'-------------------------------------------------------------
Sheets("Feuil1").Select
L1 = 1
While Cells(L1, 1) <> ""
For C1 = 1 To 13 Step 3
cle = Cells(L1, C1)
If Tab_Datas.exists(cle) = False Then
Tab_Datas(cle) = Array("", "", "", "", "", "", "", "", "", "")
End If
tmp = Tab_Datas(cle)
Select Case C1
Case 1
tmp(0) = Cells(L1, C1 + 1)
tmp(1) = Cells(L1, C1 + 2)
Case 4
tmp(2) = Cells(L1, C1 + 1)
tmp(3) = Cells(L1, C1 + 2)
Case 7
tmp(4) = Cells(L1, C1 + 1)
tmp(5) = Cells(L1, C1 + 2)
Case 10
tmp(6) = Cells(L1, C1 + 1)
tmp(7) = Cells(L1, C1 + 2)
Case 13
tmp(8) = Cells(L1, C1 + 1)
tmp(9) = Cells(L1, C1 + 2)
End Select
Tab_Datas(cle) = tmp
Next C1
L1 = L1 + 1
Wend
'-------------------------------------------------------------
' Ecriture du résultat
'-------------------------------------------------------------
Sheets("Feuil2").Select
L1 = 2
For Each cle In Tab_Datas
Cells(L1, 1) = cle
tmp = Tab_Datas(cle)
Cells(L1, 2) = tmp(0)
Cells(L1, 3) = tmp(1)
Cells(L1, 4) = tmp(2)
Cells(L1, 5) = tmp(3)
Cells(L1, 6) = tmp(4)
Cells(L1, 7) = tmp(5)
Cells(L1, 8) = tmp(6)
Cells(L1, 9) = tmp(7)
Cells(L1, 10) = tmp(8)
Cells(L1, 11) = tmp(9)
L1 = L1 + 1
Next
End Sub