'### Noms des feuilles à adapter ###
Const SOURCE As String = "feuille recueil Noms + VMA"
Const DEST As String = "Elèves-VMA"
'###################################
Sub ClassementVMA2()
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim j&
Dim T()
Set S = Sheets(SOURCE)
Set R = S.Range("b3:c" & S.[b3].End(xlDown).Row & "")
var = R
ReDim T(1 To UBound(var, 1), 1 To 21)
For i& = 1 To UBound(var, 1&)
For j& = 1 To UBound(T, 1)
If T(j&, (var(i&, 2) * 2) - 15) = "" Then
T(j&, (var(i&, 2) * 2) - 15) = var(i&, 1)
Exit For
End If
Next j&
Next i&
Set S = Sheets(DEST)
Set R = S.Range(S.Cells(4, 2), S.Cells(UBound(var, 1) + 4 - 1, 22))
R = T
End Sub