Option Explicit
Sub Données()
Dim TDon(), Dico As New Dictionary, L As Long, TRés()
With Sheets(2).Range("A1"): TDon = .Offset(, 2).Resize(.End(xlDown).Row).Value: End With
For L = 1 To UBound(TDon, 1)
If TDon(L, 1) <> "" Then Dico(TDon(L, 1)) = 1
Next L
With Sheets(1).Range("B1"): TDon = .Offset(, -1).Resize(.End(xlDown).Row, 5).Value: End With
ReDim TRés(1 To UBound(TDon, 1), 1 To 11)
For L = 1 To UBound(TDon, 1)
If Dico.Exists(TDon(L, 4)) Then
Select Case TDon(L, 3)
Case "Lola": TRés(L, 1) = TDon(L, 1): TRés(L, 2) = "Lola": TRés(L, 3) = Right(TDon(L, 4), 1)
Case "Quentin": TRés(L, 5) = TDon(L, 1): TRés(L, 6) = "Quentin": TRés(L, 7) = Right(TDon(L, 4), 1)
Case "Pierre": TRés(L, 9) = TDon(L, 1): TRés(L, 10) = "Pierre": TRés(L, 11) = Right(TDon(L, 4), 1)
End Select: End If: Next L
Sheets(1).Range("F1").Resize(UBound(TRés, 1), 11).Value = TRés
End Sub