Copy from one worksheet to another

[Gene]

I have the following macro. I desire that it copy from "Orders" to
"Pofit_Loss_Statement" the value in "ID" (a drop-down list) and paste it into
the first blank line in the Profit_Loss_Statement.

The code works fine as long as I stay on the Orders worksheet. Once I
inserted the code to switch to the Profit_Loss_Statement, I started getting
Runtime Error 1004. What am I doing wrong?

Sub SelectItem()
'
' SelectItem Macro
' Macro recorded 05/20/2007 by EuGene C. White, CNA
'
Worksheets("Orders").Activate ' extra code
Range("ID").Select
Selection.Copy
Worksheets("Profit_Loss_Statement").Activate
Range("A3").Select
Do Until Cells(ActiveCell.Row + 1, 1) = ""

If ActiveCell = "" Then
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
Cells(ActiveCell.Row + 1, 1).Select
End If
Loop
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

 

[Ron de Bruin]

Hi Gene

See this page for a example without selecting and looping
http://www.rondebruin.nl/copy1.htm

 

[JLGWhiz]

This would be my approach:
Sub SelectItem()
Worksheets("Orders").Activate ' extra code
Range("ID").Copy
Worksheets("Profit_Loss_Statement").Activate
Range("A3").Activate
If ActiveCell = "" Then
ActiveCell.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
End Sub