Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "R#" Then Exit Sub
Dim tablo, resu(), d As Object, i&, x$, n&, lig&, numfeuille%, test As Boolean, j%
'---analyse du tableau source---
tablo = Sheets("Base").[A1].CurrentRegion.Resize(, 4) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 4)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = tablo(i, 1) & tablo(i, 2)
If Not d.exists(x) Then
n = n + 1
d(x) = n 'mémorise la ligne
resu(n, 1) = tablo(i, 1)
resu(n, 2) = tablo(i, 2)
End If
lig = d(x)
If tablo(i, 4) = "AM" Then
resu(lig, 3) = resu(lig, 3) + Val(tablo(i, 3))
ElseIf tablo(i, 4) = "AB" Then
resu(lig, 4) = resu(lig, 4) + Val(tablo(i, 3))
End If
Next i
'---restitutions---
Application.ScreenUpdating = False
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
With Sh.[A2]
'---1ère restitution---
If n Then
.Resize(n, 4) = resu
.Resize(n, 4).Sort .Cells, xlAscending, , .Cells(1, 2), xlAscending, Header:=xlNo 'tri sur les colonnes A et B
End If
.Offset(n).Resize(Sh.Rows.Count - n - .Row + 1, 4).ClearContents 'RAZ en dessous
'---répartition entre les feuilles---
tablo = .Cells(0, 1).Resize(n + 2, 4)
ReDim resu(1 To UBound(tablo), 1 To 4)
numfeuille = Val(Right(Sh.Name, 1))
n = 0
For i = 2 To UBound(tablo) - 1
test = tablo(i, 1) = tablo(i - 1, 1) Or tablo(i, 1) = tablo(i + 1, 1)
Select Case numfeuille
Case 1: If test Then n = n + 1: For j = 1 To 4: resu(n, j) = tablo(i, j): Next j
Case 2: If Not test And tablo(i, 3) <> "" And tablo(i, 4) <> "" Then n = n + 1: For j = 1 To 4: resu(n, j) = tablo(i, j): Next j
Case 3: If Not test And (tablo(i, 3) = "" Or tablo(i, 4) = "") Then n = n + 1: For j = 1 To 4: resu(n, j) = tablo(i, j): Next j
End Select
Next i
'---2ème restitution---
If n Then
.Resize(n, 4) = resu
.Resize(n, 4).Borders.Weight = xlThin 'bordures
End If
.Offset(n).Resize(Sh.Rows.Count - n - .Row + 1, 4).Delete xlUp 'RAZ en dessous
End With
With Sh.UsedRange: End With 'ajuste la barre de défilement verticale
End Sub
