empty cell / copy and paste

[Helmut]

From Active cell say "A15" determine if "D16" is 'empty'.
If yes THEN
copy "A:B15" to "A:B16" AND "G:H15" to "G:H16"
THEN Loop until next row empty
If no ELSE
do something else (not sure yet what)

I'm stuck on doing the first few lines.
Thanks

[Patrick Molloy]

dim cell as range

'try
set cell = selection
'or
set cell = Range("A15")

do while cell.Value<>""

IF cells( cell.Row + 1, "D")="" THEN
Range( cells( cell.Row , "A"), cells( cell.Row , "B")).Copy
Range( cells( cell.Row+1 , "A"), cells( cell.Row+1 ,
"B"))..PasteSpecial = xlPasteAll
Range( cells( cell.Row , "G"), cells( cell.Row , "H")).Copy
Range( cells( cell.Row+1 , "G"), cells( cell.Row+1 ,
"H"))..PasteSpecial = xlPasteAll
End If

set cell = cell.Offset(1)
LOOP

"Helmut" <Hel...@discussions.microsoft.com> wrote in message
news:A7ADCD8B-8C55-4543...@microsoft.com...

[Dominik Petri]

Helmut schrieb:

Helmut,

not sure what you want... What do you mean by A:B15? A15:B15?
Maybe this gives you a start:

If Len(Range("D16").Value)=0 then
Range("A16:B16").Value = Range("A15:B15").Value
Range("G16:H16").Value = Range("G15:H15").Value
End If

Regards,
xlDominik.

[Patrick Molloy]

i use .Value mostly as i think its usually whats required. However, it was
pointed out to me that as its a table, its quite likely that the cells
contain formulae as well as values and format...hence my COPY
but I agree with VALUE if thats no issue

"Dominik Petri" <xlDo...@gmx.de> wrote in message
news:OV7Hd6U2...@TK2MSFTNGP06.phx.gbl...

[Helmut]

When I run the following, it executes ONCE, copying A15:B15 to A16:B16 but
DOES NOT execute the "Set cell = cell.Offset(1)" and therefore not the Loop
and I get an Error: "Object missing 424"

Sub order()

' check if new items are added and copy formulas

Range("B8").Select
Selection.End(xlDown).Select


Dim cell As Range

Set cell = Selection

Do While cell.Value <> ""

If Cells(cell.Row + 1, "D") = "" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "B")).Copy
Range(Cells(cell.Row + 1, "A"), Cells(cell.Row + 1, "B")).PasteSpecial =
xlPasteAll
Range(Cells(cell.Row, "G"), Cells(cell.Row, "H")).Copy
Range(Cells(cell.Row + 1, "G"), Cells(cell.Row + 1, "H")).PasteSpecial =
xlPasteAll
End If

Set cell = cell.Offset(1)

Loop

' put value in lastrwo +1
Range("B8").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 3).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"

'delete rows where cell in column E is empty

Dim i, j As Integer

Set starta = ActiveSheet.Range("E1")
lr = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Row

For i = lr To 0 Step -1
If starta.Offset(i, 0).Value = 0 Then starta.Offset(i,
0).EntireRow.delete
Next i

' Delete last two rows with invalid information
Range("E8").Select
Selection.End(xlDown).Select
Selection.EntireRow.delete

End Sub

Everything else works ok.
Thanks if you can get me the Error fixed.
Helmut

[Patrick Molloy]

> Range("B8").Select
> Selection.End(xlDown).Select
you've selected the bottom cell in the column
the next cell down is selected by
> Range("B8").Select
> Selection.End(xlDown).Select
>

at the end of the loop you move down
> Set cell = cell.Offset(1)
so of course its empty

try moving UP the list, change to
Set cell = cell.Offset(-1)

"Helmut" <Hel...@discussions.microsoft.com> wrote in message

news:9BCBD600-A89C-4896...@microsoft.com...

[Patrick Molloy]

excuse typo - sorry

you've selected the bottom cell in the column

[Helmut]

Patrick,
The problem is during execution of this:

If Cells(cell.Row + 1, "D") = "" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "B")).Copy
Range(Cells(cell.Row + 1, "A"), Cells(cell.Row + 1, "B")).PasteSpecial =
xlPasteAll

=====
here I get "Error 424 - Object Missing
=====

Range(Cells(cell.Row, "G"), Cells(cell.Row, "H")).Copy
Range(Cells(cell.Row + 1, "G"), Cells(cell.Row + 1, "H")).PasteSpecial =
xlPasteAll
End If