Solved: Duplicating the cell above the current cell

[SGBurton123]

Brand new to Excel VBA, used Quattro Pro for years

Question : trying to duplicate the cell above the active cell down through a column until reaching a '999' stop ... the following isn't working for me :

[vba]Dim PSRegCell
For Each PSRegCell In Range("A1")
If ActiveCell.Value <> 999 Then
ActiveCell.Offset(-1, 0).Range("a1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Else: End
End If
Next PSRegCell[/vba]
I know this is simple, but I've been handed a project for which I'm unprepared ... thanks !

[Bob Phillips]

A bit more detail.

Are you trying to insert a new row and copy the row above, your code will overwrite the row?

What is the 999 test for, is it meant to be the end? Is there a 999 cell, and if so, are there cells after it.

Maybe give a before and after example.

[austenr]

So you are saying you want to copy the contents of cell A1 down until you get to a cell withthe value of 999?

[Bob Phillips]

So you are saying you want to copy the contents of cell A1 down until you get to a cell with the value of 999?

Touché

[SGBurton123]

no, copycontents of A1 to A2, then go to A3, check for '999', if not, then copy A2 to A3, then go to A4, check for '999', then copy A3 to A4 ... ad finitum

some cells will have contents, some will not

[Bob Phillips]

I don't think this is what you want, but it is what I think you are asking for

[vba]

Dim PSRegCell As Range

With ActiveSheet

For Each PSRegCell In Range(Range("A2"), Range("A1").End(xlDown))
With PSRegCell
If .Value <> 999 Then
.Offset(-1, 0).Copy .Offset(0, 0)
End If
End With
Next PSRegCell
End With
[/vba]

[SGBurton123]

no, not working

using excel 2010

here's a simple before (Col B) / and after (Col D)

[austenr]

Why on earth would you want to do that? Just asking?

[SGBurton123]

I get a "crosstab" of accounts from an external database, which I paste into excel, from which I will need to do vlookups on concatenated columns ... each of the column cells needs to be filled to get a valid lookup ... I can copy and paste down the blank cells in the column, but it's about 2000 rows and 90 or so different data elements with blank cells in between

in other words, you don't want to know

[Bob Phillips]

[vba]

Dim PSRegCell As Range

With ActiveSheet

For Each PSRegCell In Range(.Range("B2"), .Range("B" & .Rows.Count).End(xlUp))
With PSRegCell
If .Value <> 999 Then
If .Value = "" Then
.Offset(-1, 0).Copy .Offset(0, 0)
End If
End If
End With
Next PSRegCell
End With
[/vba]

[SGBurton123]

perfect, nice work, saved my week !

[davmec93]

You seem to have posted this question twice. The first time was under the topic Conditional Duplicating down a column