Cut & Delete

[lapta301]

Dear All

Due to the way that data comes in to me I have a rather large sheet which I receive on a regular basis where I need to move the data in cell A2 to A3 then delete row 2.

Then repeat this for the remainder of the column so the the value in A4 goes to A5 with row 4 being deleted.

Basically each alternate row is deleted after the transfer of the value in A2, A4, A6 etc.

I hope that my description makes sense and as always many thanks for your help.

 

[texasalynn]

this is untested - be sure to make a copy of your workbook before trying this

Sub importcleanup()
Dim i As Long, LR As Long
LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LR Step 2
    Range("A" & i).Cut Destination:=Range("A" & i + 1)
Next i
End Sub

 

[Mike Blackman]

Hi,

How about this;

Sub MoveData()

For i = Rows.count - 1 To 2 Step 2
    Range("A" & i + 1) = Range("A" & i)
    Rows(i).Delete
Next i

End Sub

 

[lapta301]

Mike

Nothing much is happening?

 

[lapta301]

TexasLynn

Thank you for responding so quickly.

The moving of the text is working fine but at present the empty rows still remain.
I can obviously work around that but it would be nice if the blank rows could be deleted in one swoop.

 

[Mike Blackman]

Thats simply because it starts at the bottom and works up, Try;

Sub MoveData()

Dim lRow As Long

lRow = Range("A" & Rows.count).End(xlUp).Row

For i = Application.Even(lRow) To 2 Step 2
    Range("A" & i + 1) = Range("A" & i)
    Rows(i).Delete
Next i

End Sub

 

[texasalynn]

modified slightly

Sub importcleanup()
Dim i As Long, LR As Long
LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = LR To 2 Step -2
    Rows(i).Cut Destination:=Rows(i + 1)
    Rows(i).Delete
Next i
End Sub

 

[lapta301]

TexasaLynn

I'm not sure if it was your intention but I have added your ideas together and voila it works fine.

Thank you so much for taking the time.

Many thanks

Lapta301

 

[lapta301]

Mike

Still nothing go on.