Sub LotAPS()
Dim o As Object 'déclare la variable o (Onglet)
Dim d As Object 'déclare la variable d1 (Dictionnaire)
Dim tcle As Variant 'déclare la variable tcle (Tableau des CLÉs)
Dim tit As Variant 'déclare la variable tit (Tableau des ITems)
Dim t() As Integer 'déclare le tableau de variables indéxées t (Total)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
'**********************************************************************************
'récupère l'ensemble des "Nº de prix" du classeur sans doublon dans le tableau tcle
'**********************************************************************************
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 1
For Each o In Sheets 'boucle 1 : sur tous les onglets du classeur
If Not o.Name = "RECAP" Then 'condition : si le nom de l'onglet n'est pas "RECAP"
For Each cel In o.Range("A7:A1000") 'boucle 2 : sur toutes les cellules cel de la plage A7:A1000
If cel.Value <> "" Then If Not d.exists(cel.Value) Then d.Add cel.Value, o.Name & "/" & cel.Row 'si la cellule n'est pas vide alimente le dictionnaire d
Next cel 'prochaine cellule de la boucle 2
End If 'fin de la condition
Next o 'prochain onglet de la boucle 1
tcle = d.keys 'récupère les Nº de prix sans doublons dans le tableau tcle (clés)
tit = d.items 'récupère les nom de l'onglet et numéro de ligne dans le tableau tit (items)
'************************************************************
'calcul des totaux dans le tableau de variables indexées t(i)
'************************************************************
ReDim t(d.Count - 1) 'redimentionne le tableau des totaux t
For i = 0 To UBound(tcle) 'boucle 1 : sur tous les Nº de prix du tableau tb1
For Each o In Sheets 'boucle 2 : sur tous les onglets du classeur
If Not o.Name = "RECAP" Then 'condition : si les nom de l'onglet n'est pas "RECAP"
On Error Resume Next 'gestion des erreurs (passe à la ligne suivante si une erreur a été générée)
'définit le total t(i) (génère une erreur si le Nº de prix n'esxiste pas dans l'onglet o
t(i) = t(i) + CInt(o.Range("A7:A1000").Find(tcle(i), , xlValues, xlWhole).Offset(0, 2))
If Err <> 0 Then Err = 0 'si une erreur a été gérérée, annule l'erreur
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Next o 'prochain onglet de la boucle 2
Next i 'prochain Nº de prix de la boucle 1
'*******************************************
'placement des données dans l'onglet "RECAP"
'*******************************************
With Sheets("RECAP") 'prend en compte l'onglet "RECAP"
.Range("A7").Resize(d.Count) = Application.Transpose(tcle) 'place les "Nº de prix" en A7 de l'onglet "RECAP"
.Range("C7").Resize(d.Count) = Application.Transpose(t) 'place les totaux en C7 de l'onglet "RECAP"
For i = 0 To UBound(tit)
.Cells(i + 7, 2).Value = Sheets(Split(tit(i), "/")(0)).Cells(Split(tit(i), "/")(1), 2)
.Cells(i + 7, 4).Value = Sheets(Split(tit(i), "/")(0)).Cells(Split(tit(i), "/")(1), 4)
.Cells(i + 7, 5).Value = Sheets(Split(tit(i), "/")(0)).Cells(Split(tit(i), "/")(1), 5)
.Cells(i + 7, 6).Value = Sheets(Split(tit(i), "/")(0)).Cells(Split(tit(i), "/")(1), 6)
Next i
End With 'fin de la prise en compte de l'onglet "RECAP"
'*******************************************
'Tri des Numéros d'articles
'*******************************************
ActiveWorkbook.Worksheets("RECAP").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RECAP").Sort.SortFields.Add Key:= _
Range("A7:FIN"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("RECAP").Sort
.SetRange Range("A7:FIN")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.ScreenUpdating = True
End Sub
