Sub extract()
Application.Calculation = xlCalculationManual
Dim Code_client, L1
Dim Tab_client
Set Tab_client = CreateObject("scripting.dictionary")
'--------------------------------
' lecture des données
'--------------------------------
Sheets("Référence").Activate
L1 = 4
While Cells(L1, 2) <> ""
Code_client = Trim(Cells(L1, 2))
If Tab_client.exists(Code_client) Then
tmp = Tab_client(Code_client)
tmp(1) = tmp(1) + Cells(L1, 8)
tmp(2) = tmp(2) + Cells(L1, 9)
Tab_client(Code_client) = tmp
Else
Tab_client(Code_client) = Array(Cells(L1, 3), Cells(L1, 8), Cells(L1, 9))
End If
L1 = L1 + 1
Wend
'--------------------------------
' ecriture resultats
'--------------------------------
Sheets("Récapitulatif").Activate
Cells(1, 1) = ("Applicant / Donneur d'ordre")
Cells(1, 2) = ("Applicant name : Nom du donneur d'ordre")
Cells(1, 3) = ("Qty IP Trunk / Qté IP Trunk")
Cells(1, 4) = ("Service IP Trunk")
Cells(1, 5) = ("Qty IP Users / Qté IP Users")
Cells(1, 6) = ("Service IP Users")
Rows("2:65000").Delete Shift:=xlUp
L1 = 2
For Each Code_client In Tab_client
Cells(L1, 1) = Code_client ' numéro client
Cells(L1, 2) = Tab_client(Code_client)(0) ' Nom client
Cells(L1, 3) = Tab_client(Code_client)(1) ' Qte IT
Cells(L1, 4) = ("3EY98994AA")
Cells(L1, 5) = Tab_client(Code_client)(2) ' Qte IU
Cells(L1, 6) = ("3EY98994AA")
L1 = L1 + 1
Next
Application.Calculation = xlCalculationAutomatic
End Sub