If you are trying to copy each cell to b4 in advice and then print advice
and then do the next

sub trythis()'untested
with Sheets("Data")
lastrow=.cells(2,"a").end(xldown).row
for each c in .range("a2:a" & lastrow)
sheets("advice").range("b4).value=c.value
sheets("advice").printout
next c
end with
end sub

Sheets("Data").Select
Range("A2").Select
Do Until ActiveCell = ""
If ActiveCell "" Then
Selection.Copy
Sheets("Advice").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Advice").Select

If Range("P51") 0 Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If

Sheets("Data").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
End If
Exit Do
Sheets("Lookup").Select

End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"bob" wrote in message
...
Hi I have the following code which I need to Loop but it keeps coming up
with the following error

Compile Error Loop Without Do

Can you see where I have gone wrong? I do have a Do Until statement, if I
take out the word Loop out it comes up with the Error
Compile Error Do Without Loop what's wrong?

Sheets("Data").Select
Range("A2").Select
Do Until ActiveCell = ""
If ActiveCell "" Then
Selection.Copy
Sheets("Advice").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Advice").Select
If Range("P51") 0 Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Sheets("Data").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
End If
Exit Do
Sheets("Lookup").Select

End Sub


Thanks Bob