Sub test()
Dim Derlig As Long
With Sheets("Sheet1")
Derlig = .Range("A2").End(xlDown).Row - 1
For i = Derlig To 2 Step -2
.Range("A" & i).Copy
.Range("F" & i - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Range("A" & i).EntireRow.Delete
Next i
End With
End Sub
'--------
.Range("A" & i).EntireRow.Delete
'--------