Remanier un tablo par vba

Sub travdemande()

Dim i As Long
Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long
Dim dl1 As Long


'**********************************
nomfeuille1 = ActiveSheet.Name '"Feuil1"
col1 = "a"
lidep1 = 1
dl1 = Sheets(nomfeuille1).Range(col1 & "65536").End(xlUp).Row + 2
If (dl1 Mod 2) > 0 Then

Call MsgBox("Le nombre de lignes n'est pas un nombre pair" _
            & vbCrLf & "" _
            , vbCritical, Application.Name)

Exit Sub

End If

'************************************
With Sheets(nomfeuille1)

For i = dl1 To 2 Step -2

    .Range("A" & i & ":j" & i).Copy Destination:=.Range("k" & i - 1)
    .Rows(i).Delete Shift:=xlUp
Next i

End With

End Sub