Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat, client$, ncol%, tablo, resu(), i&, n&, datmax&, j%, x As Variant
dat = [B1]: client = [B2] 'à adapter
If IsDate(dat) And client <> "" Then
With Sheets("BDD").[A1].CurrentRegion 'à adapter
ncol = .Columns.Count
If ncol = 1 Then ncol = 2
tablo = .Resize(, ncol) 'matrice, plus rapide, au moins 2 éléments
End With
ReDim resu(1 To UBound(tablo), 1 To 2)
For i = 1 To UBound(tablo)
If tablo(i, 1) = client And tablo(i, 2) <> "" Then
n = n + 1
resu(n, 1) = tablo(i, 2)
datmax = 0
For j = 2 To ncol
x = tablo(i, j)
If IsDate(x) Then If x <= dat Then If x > datmax Then datmax = x: resu(n, 2) = tablo(i, j + 2) 'décalage de 2 colonnes
Next
End If
Next i
End If
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A5] '1ère cellule, à adapter
Application.EnableEvents = False 'désactive les évènements
If n Then
.Resize(n, 2) = resu
.Resize(n, 2).Interior.ColorIndex = 19 'jaune clair
.Resize(n, 2).Borders.Weight = xlHairline 'bordures
.EntireColumn.AutoFit 'ajustement largeur
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 2).Delete xlUp
Application.EnableEvents = True 'réactive les évènements
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub