Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Set fbd = Sheets("Liste")
Set fplan = Sheets("Planning")
[B2:AR21].ClearContents
nblignes = fbd.[A1].CurrentRegion.Rows.Count
For i = 2 To nblignes
lieu = fbd.Cells(i, 2)
dt = fbd.Cells(i, 1)
Set result = fplan.[A:A].Find(What:=lieu, LookIn:=xlValues)
Set result2 = fplan.[1:1].Find(What:=dt, LookIn:=xlValues)
If Not result Is Nothing And Not result2 Is Nothing Then
lig = result.Row
col = result2.Column
n = Application.Count(Cells(lig, col).Resize(3, 1))
If n < 4 Then
Cells(lig + n, col + 1) = fbd.Cells(i, 4)
Cells(lig + n, col) = fbd.Cells(i, 3)
Cells(lig + n, col + 2) = fbd.Cells(i, 5)
End If
End If
Next i
End Sub