Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim t, nlig&, ncol%, P As Range, source, dest(), x$, i&, j&, k%
Application.ScreenUpdating = False
t = Intersect(Me.UsedRange, Rows("4:" & Rows.Count)) 'mémorise
nlig = UBound(t)
ncol = UBound(t, 2)
Rows("5:" & Rows.Count).ClearContents 'RAZ
With Sheets("Scope")
Set P = Intersect(.UsedRange, .Range("A3:C" & .Rows.Count))
End With
If Not P Is Nothing Then
source = P
ReDim dest(1 To UBound(source), 1 To ncol)
For i = 1 To UBound(dest)
dest(i, 1) = source(i, 3)
dest(i, 2) = source(i, 1)
dest(i, 3) = source(i, 2)
x = dest(i, 2) & dest(i, 3) 'nom + prénom
For j = 1 To nlig
If t(j, 2) & t(j, 3) = x Then
For k = 4 To ncol
dest(i, k) = t(j, k)
Next k
Exit For
End If
Next j
Next i
[A5].Resize(UBound(dest), ncol) = dest
End If
'---recherche de la dernière ligne---
Set P = Me.UsedRange
For i = P.Rows.Count To 1 Step -1
If Application.CountA(P.Rows(i)) Then Exit For
Next
Rows(P.Rows(i).Row + 1 & ":" & Rows.Count - 1).Delete
End Sub