Registrar notas

Sub Registrar()
    Dim Nota(4) As Single
   
    R = MsgBox("¿Desea registrar estas notas?", vbYesNo)
    If R = vbNo Then Exit Sub
   
    'Toma el nombre del alumno
    Alumno = Range("B2")
   
    'Toma las notas del alumno
    Range("B5").Select
    N = 0
    While ActiveCell <> ""
        N = N + 1
        Nota(N) = ActiveCell
        ActiveCell.Offset(1, 0).Select
    Wend
   
    'Selecciona la hoja Listado
    Sheets("Listado").Select
   
    'Busca la fila en blanco al final del listado
    Range("A3").Select
    While ActiveCell <> ""
        ActiveCell.Offset(1, 0).Select
    Wend
   
    'Copia los datos en la fila en blanco
    ActiveCell = Alumno
    For k = 1 To N
        ActiveCell.Offset(0, k) = Nota(k)
    Next
   
    'Regresa a la hoja Ficha
    Sheets("Ficha").Select
   
    'Borra los datos del alumno
    Range("B2,B5:B8").ClearContents
    Range("B2").Select
End Sub