Sub Transphere()
Dim i, j As Integer
Dim Cel As Range
If Sheets("NOTE").Range("A4:A" & [A65000].Row).Row >= 1 Then Sheets("NOTE").Range("A4:B" & [A65000].Row).ClearContents
With Sheets("LISTE ELEVE")
For Each Cel In .Range("B4:B" & .[B65000].End(xlUp).Row)
If Cel <> "" Then
With Sheets("NOTE")
.Cells(4 + i, 1) = j + 1
.Cells(4 + i, 2) = Cel
i = i + 1
End With
End If
j = j + 1
Next
End With
MsgBox "transfere terminé"
End Sub