Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D5:D6]) Is Nothing Then Exit Sub
Dim nom$, annee%, t, d As Object, i&, x$, n&, a, resu()
nom = [D5]: annee = [D6]
t = Sheets("SES").[A1].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
If t(i, 1) = nom And (t(i, 2) = annee Or IsEmpty(annee)) And Left(t(i, 3), 4) = "5000" Then
x = t(i, 3) & Chr(1) & t(i, 5)
If Not d.exists(x) Then d(x) = i 'mémorise la ligne
End If
Next
n = d.Count
'---transposition---
If n Then
a = d.items
ReDim resu(UBound(a), 1) 'base 0, nombre de colonnes à adapter
For i = 0 To UBound(a)
resu(i, 0) = t(a(i), 3)
resu(i, 1) = t(a(i), 5)
Next
End If
'---restitution et mises en formes---
With [D12] '1ère cellule à adapter
If n Then
.Resize(n, 2) = resu
.Resize(n, 2).Interior.ColorIndex = 6 'jaune
.Resize(n, 2).Borders.Weight = xlHairline 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 2).Delete xlUp 'RAZ sous le tableau
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub