XL 2013 Macro ou formule déplacement cellules

Option Explicit
Sub Pair_vers_impair()
    Application.ScreenUpdating = False
    Columns(2).Clear
    Range("a2").Select
    Do While ActiveCell <> ""
        Selection.Copy Destination:=Range("b" & Rows.Count).End(xlUp)(3)
        Selection.Offset(2, 0).Select
    Loop
    Range("b1:b2").Delete Shift:=xlUp
    Application.ScreenUpdating = True
End Sub

Sub DecalImpair()
 With Worksheets("Feuil1")
 For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row Step 2
    .Cells(i - 1, 2) = .Cells(i, 1)
    .Cells(i, 1).ClearContents
 Next
 End With
End Sub

Sub Decal()
 For i = 2 To Range("A1:A" & [A65000].End(xlUp).Row).Count Step 2
    Cells(i, 1).Cut  Cells(i - 1, 2)
 Next
End Sub