I think this does what you say you want to do...

Sub ProcessColumnA()
Dim X As Long
Dim LastRow As Long
Const FirstRowWithData As Long = 2
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = LastRow To FirstRowWithData Step -1
If .Cells(X, "A").Value < "" Then
.Rows(X).Insert
.Cells(X, "A").Offset(1).Copy .Cells(X, "A")
.Cells(X, "A").Offset(1).Clear
End If
Next
End With
End Sub

--
Rick (MVP - Excel)


"Stanley Braverman" wrote in message ...
I need a macro that will:
If cell in column A is not blank. (Column A,B,C and D will contain data)
Then copy contents of that cell and then insert entire row then
copy to the new row and delete original cell. I will need a loop till done.
Thanks for any help on this macro.

Example:
Row 5 cell A5 contains data
Insert row (New Row is now row 5)(Old row now row 6)
Copy from old cell and copy to new row 5 (A 5) then(delete cell A6)
Then delete contents cell A6.

Thanks