Déplacer le contenu de cellules

Sub deplace()
Dim i

For i = 2 To 10000
    If Cells(i, 8).Font.Size = 12 Then Cells(i, 8).Font.Size = 14
Next i

For i = 2 To 1500
    If Cells(i, 8).Font.Size = 10 Then
        If Cells(i, 14) = "" Then
            Cells(i, 8).Font.Size = 12
        End If
    End If
Next i

For i = 2 To 1500
    If Cells(i, 8).Font.Size = 18 Then Cells(i, 1) = Cells(i, 8)
    If Cells(i, 8).Font.Size = 14 Then Cells(i, 2) = Cells(i, 8)
    If Cells(i, 8).Font.Size = 12 Then Cells(i, 3) = Cells(i, 8)
Next i

For i = 3 To 1500
    If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
    If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2)
    If Cells(i, 3) = "" Then Cells(i, 3) = Cells(i - 1, 3)
Next i

For i = Range("E65536").End(xlUp).Row To 2 Step -1
    If Cells(i, 5) = "" Then Cells(i, 5).EntireRow.Delete
Next i

End Sub