If Cell is empty copy to other cell, HELP please

[kulver]

Hello all,

I am trying to write a macro and I want it to do the following:

If the value in column A is empty, then copy value in G+1 column, (+ 1 meaning but one row below) and paste it to G+2. Do this for all the empty value in A column. After that delete all the empty rows.

Thank you for your help.

 

[Teeroy]

Welcome to the forum. The following should do what you are after. Since the changes made will be unrecoverable make sure you try it on a COPY of your data first.

Sub CopyDataAndDeleteBlanks()
Dim rBlankRng As Range, rCell As Range
Set rBlankRng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("A")).SpecialCells(xlCellTypeBlanks)
For Each rCell In rBlankRng
    rCell.Offset(2, 6).Value = rCell.Offset(1, 6).Value
Next
rBlankRng.EntireRow.Delete
End Sub

 

[kulver]

Thanks for the help! It worked.

Just want to double check to fully understand the code:
Dim rBlankRng As Range, rCell As Range, what does this define?

 

[kulver]

Also Teeroy, what would be the code for this:
If the cell in column A is empty, and there are 4 empty cells below 1st empty cell then delete those 4 rows;

Or if its possible to make it even smarter, if the cell in column A is empty and there are more than 3 empty cells below that cell, delete n-1 rows.
(the ultimate goal is to have 2 empty cells - the first one, and the last one only.

Thanks a lot for the help.

 

[Teeroy]

Thanks for the help! It worked.

Just want to double check to fully understand the code:
Dim rBlankRng As Range, rCell As Range, what does this define?

This defines (DIMensions) the variables as Range Objects.

 

[Teeroy]

Also Teeroy, what would be the code for this:
If the cell in column A is empty, and there are 4 empty cells below 1st empty cell then delete those 4 rows;

Or if its possible to make it even smarter, if the cell in column A is empty and there are more than 3 empty cells below that cell, delete n-1 rows.
(the ultimate goal is to have 2 empty cells - the first one, and the last one only.

Thanks a lot for the help.

Try the following (on a COPY of your data);

Sub teeroy()
Dim rRng As Range, rBlankRng As Range
Set rBlankRng = Intersect(Columns("A"), ActiveSheet.UsedRange).SpecialCells(xlCellTypeBlanks)
For Each rRng In rBlankRng.Areas
    If rRng.Cells.Count > 3 Then
        Range(rRng.Cells(2, 1), rRng.Cells(rRng.Cells.Count - 1, 1)).EntireRow.Delete
    End If
Next
End Sub