We have a quote sheet with a signature line and the user clicks a SIGN
SHEET button for which the code copies from a group of shapes with
user's signatures and places and aligns that shape on the signature
line. The code runs fine in 2003 & 2007, but it doesn't paste the
shape in 2010. The code runs through and doesn't crash, but it doesn't
paste the shape. Is it something I need to add to the code, a
reference checked on, or something else? See code below & any info on
this would be greatly appreciated.

Sub Sign()

Dim shp As Shape
Dim x As Integer
Dim c As Integer

Application.ScreenUpdating = False

If UCase(Application.UserName) Like "DAN*" Then c = 1
If UCase(Application.UserName) Like "ROB*" Then c = 2
If UCase(Application.UserName) Like "MELV*" Then c = 3
If UCase(Application.UserName) Like "GEO*" Then c = 4
If UCase(Application.UserName) Like "ABE*" Then c = 6
If UCase(Application.UserName) Like "ANN*" Then c = 6
If UCase(Application.UserName) Like "WAL*" Then c = 5

If UCase(Application.UserName) Like "CUR*" Then c = 6
If UCase(Application.UserName) Like "DARRE*" Then c = 6



Select Case c


Case 1
Set P = Sheets("Rates").Shapes("Object 3")
Range("Rep").Value = "Danny"


Case 2
Set P = Sheets("Rates").Shapes("Object 2")
Range("rep").Value = "Robert"

Case 3
Set P = Sheets("Rates").Shapes("Object 4")
Range("rep").Value = "Melvin"

Case 4
Set P = Sheets("Rates").Shapes("Picture 1")
Range("rep").Value = "George"

Case 5
Set P = Sheets("Rates").Shapes("Object 5")
Range("rep").Value = "Walt"

Case 6
PickName.Show 'USERFORM TO SELECT NAME

Case Else
MsgBox Application.UserName & " is not authorized to sign"
Exit Sub

End Select

'delete all objects and pictures from A and quote

Sheet1.Activate


For Each shp In ActiveSheet.Shapes
On Error Resume Next
If shp.Name Like "*Object*" Then shp.Delete
If shp.Name Like "*Picture*" Then shp.Delete
Next

Sheet2.Activate




For Each shp In ActiveSheet.Shapes
' On Error Resume Next
If shp.Name Like "*Object*" Then shp.Delete
If shp.Name Like "*Picture*" Then shp.Delete
Next

On Error GoTo 0



P.Copy
Sheet1.Select
Sheets("QUOTEA").Range("signature").Select
ActiveSheet.Paste



x = Range("signature").row

Selection.Top = Worksheets("QUOTEA").Cells(x + 1, 31).Top
Selection.Height = Worksheets("QUOTEA").Cells(x - 1, 31).Top -
Worksheets("QUOTEA").Cells(x + 1, 31).Top
Selection.Left = Worksheets("QUOTEA").Range("signature").Left

Sheet2.Select

Sheets("Quote").Range("Q_Rep").Select
ActiveSheet.Paste

x = Range("Q_rep").row

Selection.Top = Worksheets("Quote").Cells(x, 31).Top
Selection.Height = Worksheets("Quote").Cells(x, 31).Height
Selection.Left = Worksheets("Quote").Range("Q_Rep").Left


Cells(1, 1).Activate

Sheet1.Activate

Application.CutCopyMode = False

Cells(1, 1).Activate

Application.ScreenUpdating = True

End Sub

Some observations and suggestions...

"P" is not declared.
You reference 5 different sheets: Rates, Quote, QuoteA, Sheet1, Sheet2
Some possible overlap there.
Case 6 shows no code for identifying a particular shape.
'---

Remove all "On Error Resume Next" statements to be sure some code isn't being skipped.
Check the Rates sheet and verify the shape names are what you think they are.
'---

Try these alternative paste methods...
P.Copy
Sheets("QUOTEA").Range("signature").PasteSpecial
-or-
P.Copy
Sheets("QUOTEA").Paste Destination:=Sheets("QUOTEA").Range("signature")

--
Jim Cone
Portland, Oregon USA .
http://www.mediafire.com/PrimitiveSoftware .
(List Files XL add-in: finds and lists files/folders with hyperlinks)





"Darrell L."
wrote in message
...
We have a quote sheet with a signature line and the user clicks a SIGN
SHEET button for which the code copies from a group of shapes with
user's signatures and places and aligns that shape on the signature
line. The code runs fine in 2003 & 2007, but it doesn't paste the
shape in 2010. The code runs through and doesn't crash, but it doesn't
paste the shape. Is it something I need to add to the code, a
reference checked on, or something else? See code below & any info on
this would be greatly appreciated.

Sub Sign()

Dim shp As Shape
Dim x As Integer
Dim c As Integer

Application.ScreenUpdating = False

If UCase(Application.UserName) Like "DAN*" Then c = 1
If UCase(Application.UserName) Like "ROB*" Then c = 2
If UCase(Application.UserName) Like "MELV*" Then c = 3
If UCase(Application.UserName) Like "GEO*" Then c = 4
If UCase(Application.UserName) Like "ABE*" Then c = 6
If UCase(Application.UserName) Like "ANN*" Then c = 6
If UCase(Application.UserName) Like "WAL*" Then c = 5

If UCase(Application.UserName) Like "CUR*" Then c = 6
If UCase(Application.UserName) Like "DARRE*" Then c = 6

Select Case c
Case 1
Set P = Sheets("Rates").Shapes("Object 3")
Range("Rep").Value = "Danny"

Case 2
Set P = Sheets("Rates").Shapes("Object 2")
Range("rep").Value = "Robert"
Case 3
Set P = Sheets("Rates").Shapes("Object 4")
Range("rep").Value = "Melvin"
Case 4
Set P = Sheets("Rates").Shapes("Picture 1")
Range("rep").Value = "George"
Case 5
Set P = Sheets("Rates").Shapes("Object 5")
Range("rep").Value = "Walt"
Case 6
PickName.Show 'USERFORM TO SELECT NAME
Case Else
MsgBox Application.UserName & " is not authorized to sign"
Exit Sub
End Select

'delete all objects and pictures from A and quote

Sheet1.Activate
For Each shp In ActiveSheet.Shapes
On Error Resume Next
If shp.Name Like "*Object*" Then shp.Delete
If shp.Name Like "*Picture*" Then shp.Delete
Next

Sheet2.Activate
For Each shp In ActiveSheet.Shapes
' On Error Resume Next
If shp.Name Like "*Object*" Then shp.Delete
If shp.Name Like "*Picture*" Then shp.Delete
Next

On Error GoTo 0
P.Copy
Sheet1.Select
Sheets("QUOTEA").Range("signature").Select
ActiveSheet.Paste

x = Range("signature").row

Selection.Top = Worksheets("QUOTEA").Cells(x + 1, 31).Top
Selection.Height = Worksheets("QUOTEA").Cells(x - 1, 31).Top -
Worksheets("QUOTEA").Cells(x + 1, 31).Top
Selection.Left = Worksheets("QUOTEA").Range("signature").Left

Sheet2.Select

Sheets("Quote").Range("Q_Rep").Select
ActiveSheet.Paste

x = Range("Q_rep").row

Selection.Top = Worksheets("Quote").Cells(x, 31).Top
Selection.Height = Worksheets("Quote").Cells(x, 31).Height
Selection.Left = Worksheets("Quote").Range("Q_Rep").Left
Cells(1, 1).Activate
Sheet1.Activate
Application.CutCopyMode = False
Cells(1, 1).Activate
Application.ScreenUpdating = True
End Sub