Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mois, tablo As Range, F As Worksheet, i As Variant, P As Range, h&, nom$(), maxi#
mois = [B2]
Set tablo = ListObjects(1).Range 'tableau structuré
Set F = Sheets("Objectifs Result") 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
tablo.Offset(1).ClearContents 'RAZ
tablo.ListObject.Resize tablo.Rows("1:2") 'redimensionne
i = Application.Match(CLng(mois), F.[B:B], 0)
If IsNumeric(i) Then
Set P = F.Cells(i, 2).CurrentRegion.Resize(, 14)
h = P.Rows.Count - 2
If h > 0 Then
tablo(2, 1).Resize(h) = P(3, 2).Resize(h).Value
tablo(2, 2).Resize(h) = P(3, 1).Resize(h).Value
tablo(2, 4).Resize(h) = P(3, 5).Resize(h).Value
ReDim nom(1 To h, 1 To 1)
For i = 1 To h
maxi = 0
If IsNumeric(P(i + 2, 8)) Then maxi = P(i + 2, 8): nom(i, 1) = Split(P(2, 8), vbLf)(0)
If IsNumeric(P(i + 2, 11)) Then If P(i + 2, 11) > maxi Then maxi = P(i + 2, 11): nom(i, 1) = Split(P(2, 11), vbLf)(0)
If IsNumeric(P(i + 2, 14)) Then If P(i + 2, 14) > maxi Then nom(i, 1) = Split(P(2, 14), vbLf)(0)
Next i
tablo(2, 3).Resize(h) = nom
End If
End If
Application.EnableEvents = True 'réactive les évènements
End Sub