Cell to Row

[Stanley Braverman]

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

 

[SeanC UK]

Hi Stanley,

I'm a little confused.

You want to move down column A looking for data in cells. Once found you
want to insert a row above the located data, then copy the data up to the new
row, and finally delete the original row.

Why not insert the row after the row with data, and avoid having to copy the
data back up?

You say that if A contains data then B, C and D will also contain data. Do
you wish to copy all four of these cells, or just A, and were you planning on
deleting the contents of B, C and D after the copy?

Here is some code that should help you start, if you let me know the answers
to the above then we can try to refine the code as necessary.

This code loops from the last filled cell in column A up to row 1. I looped
it this way because otherwise, going down, you have to adjust the loop
counter everytime you insert a row.

Public Sub Temp()
Dim lngRowCount As Long
For lngRowCount = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Not IsEmpty(Cells(lngRowCount, 1)) Then
Rows(lngRowCount + 1).EntireRow.Insert shift:=xlDown
End If
Next
End Sub

I hope this helps,

Sean.

 

[Rick Rothstein]

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

 

[Stanley Braverman]

Thanks Rick for this code. I am getting subscript out of range error.

Thanks Stan
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

 

[Stanley Braverman]

Hi Sean,

You want to move down column A looking for data in cells. Once found you
want to insert a row above the located data, then copy the data up to the
new
row, and finally delete the original row___

No. delete only old cell and copy only cell...not complete row

You say that if A contains data then B, C and D will also contain data. Do
you wish to copy all four of these cells, or just A

Just A

were you planning on
deleting the contents of B, C and D after the copy?

No. Just A

 

[Rick Rothstein]

Did you change the worksheet name reference in the With statement? I used "Sheet2" as an example because you didn't tell us what the actual worksheet name is.

 

[Stanley Braverman]

I just changed it and still getting same subscript out of range error.
Could you change code to active worksheet?

Thanks, Stan


Did you change the worksheet name reference in the With statement? I used
"Sheet2" as an example because you didn't tell us what the actual worksheet
name is.

 

[Stanley Braverman]

Example of what I need:
Column A B C D
time for A Break original row

New inserted row:
Column A B C D
time inserted row
for A Break original row

Public Sub Temp()
Dim lngRowCount As Long
For lngRowCount = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Not IsEmpty(Cells(lngRowCount, 1)) Then
Rows(lngRowCount + 1).EntireRow.Insert shift:=xlDown
End If
Next
End Sub

 

[Rick Rothstein]

Sure, just replace this line...

With Worksheets("Sheet2")

with this one...

With ActiveSheet

 

[Stanley Braverman]

YES... It works Great....

Thanks

Stan

Sure, just replace this line...

With Worksheets("Sheet2")

with this one...

With ActiveSheet