PDA

View Full Version : Code returning error '1004'



babycody
03-13-2005, 09:24 AM
I picked up some code from http://www.vbaexpress.com/forum/showthread.php?t=2276&highlight=excel (http://www.vbaexpress.com/forum/showthread.php?t=2276&highlight=excel)
This code works very well, but I needed to modify it for my needs. I am having a problem running the code more than once. The first time it runs very nicely. After that I get an error: Run-time error '1004': Copy method of Worksheet class failed. The line of code ActiveSheet.Copy is highlighted in yellow. Could someone take a look at this? I am still a novice, and as such have probably done something really rooky like. One thing that I thought might be a problem is the VBA sheet name gets changed every time. Not the (Sheet2) but the internal Sheet2 that VBA uses and can't be changed by renaming a tab. Well here is what I have so far:
Private Sub CommandButton1_Click()
'
' ' this macro saves the active sheet to a cell value as seen below (5, 9) = Cell I5
'
'Variable declaration
Dim oApp As Object, _
oMail As Object, _
wb As Workbook, _
FileName As String

'Turns off screen updating
Application.ScreenUpdating = False
Range("A1:F369").Select
Selection.Copy
Sheets("Sheet1").Select
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Columns.AutoFit
ActiveSheet.Rows.AutoFit
'Makes a copy of the active sheet and save it to
'a temporary file
ActiveSheet.Copy
Set wb = ActiveWorkbook
'
' '-----------this macro saves the active sheet to a cell value as seen below (5, 9) = Cell I5

FileName = Cells(5, 9).value & " .xls"
On Error Resume Next
Kill "C:\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="C:\Documents and Settings\me you\My Documents\" & FileName

'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a To recipient
.To = "someone@somewhere.com"
'Uncomment the line below to hard code a CC recipient
.CC = "someone@somewhere.com;someone@somewhere.com"
'Uncomment the line below to hard code a Bnn recipient
'.Bcc = "someone@somewhere.com"
'Uncomment the line below to hard code a subject
.Subject = " Please review " & Cells(5, 9).value
.Body = "I have attached to this email " & Cells(5, 9).value
.Attachments.Add wb.FullName
.Display
ActiveWorkbook.Close
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End With

'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
Thanks for any help you can offer :help :beg::anyone:

Norie
03-13-2005, 09:47 AM
Why are you selecting Sheet1 anyway?

Private Sub CommandButton1_Click()
'
' ' this macro saves the active sheet to a cell value as seen below (5, 9) = Cell I5
'
'Variable declaration
Dim oApp As Object
Dim oMail As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim FileName As String

'Turns off screen updating
Application.ScreenUpdating = False

Range("A1:F369").Copy

Sheets.Add

Set ws = ActiveSheet

ws.Range("A1").PasteSpecial Paste:=xlPasteAll

ws.Columns.AutoFit

ws.Rows.AutoFit
'Makes a copy of the active sheet and save it to
'a temporary file
ws.Copy
Set wb = ActiveWorkbook
'
' '-----------this macro saves the active sheet to a cell value as seen below (5, 9) = Cell I5

FileName = Cells(5, 9).Value & " .xls"
On Error Resume Next
Kill "C:\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="C:\Documents and Settings\me you\My Documents\" & FileName

'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a To recipient
.To = "someone@somewhere.com"
'Uncomment the line below to hard code a CC recipient
.CC = "someone@somewhere.com;someone@somewhere.com"
'Uncomment the line below to hard code a Bnn recipient
'.Bcc = "someone@somewhere.com"
'Uncomment the line below to hard code a subject
.Subject = " Please review " & Cells(5, 9).value
.Body = "I have attached to this email " & Cells(5, 9).value
.Attachments.Add wb.FullName
.Display
ActiveWorkbook.Close
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End With
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub

babycody
03-13-2005, 10:06 AM
Why are you selecting Sheet1 anyway?

I don't know. It wasn't really needed since I had selected a range on the sheet to copy. I think I had left this after adding the range. The range was introduced to keep the file from being bloated. Thanks for the help I am about to try it out. Can you do me a favor and edit your post to remove my email address? My original post didn't have it in there, and I don't know how it ended up in your post.

Norie
03-13-2005, 10:13 AM
Can you do me a favor and edit your post to remove my email address? My original post didn't have it in there, and I don't know how it ended up in your post.
Done.

The reason it was there is because I has actually copied the code from the (cross) post on MrExcel, not here.

babycody
03-13-2005, 10:17 AM
Thanks Norie. Your code worked like a charm. I am reviewing it to catch my mistakes. First I have to go to MrExcel and unadvertise my email address. :)

Norie
03-13-2005, 10:19 AM
On MrExcel it will only be text and you can't edit a message after a certain time period.

babycody
03-13-2005, 10:37 AM
Thanks for the heads up. I managed to beat the window for editing that post. Well now I am going to experiment with printing hard copies of this sheet. Wish me luck. Thanks again Norie.

Norie
03-13-2005, 10:41 AM
Actually I'm not sure if there is a limit now. There definitely used to be but perhaps it's changed.

babycody
03-13-2005, 12:36 PM
Well I thought it was going to run without fail. I am getting the same error for ws.Copy. It's strange sometimes it will run a few times before an error occurs, and other times it fails on the first attempt. I don't understand why copying a worksheet should be a big deal in this code. All I am asking it to do is make a copy of the worksheet and save it to a new workbook.

I added this Application.CutCopyMode = False before ws.Copy and I haven't received any errors since. Crossing fingers that this fixes everything.

Norie
03-13-2005, 02:08 PM
Is there anything different going on elsewhere when it fails?

Zack Barresse
03-13-2005, 09:02 PM
FYI, if you need a post edited, contact any Moderator over at MrExcel.com.

Also, if you cross post, please be sure and post a link to such postings in all forums. This allows any would be helpers to know what has been done and what has not; a common courtesy. :)

BlueCactus
03-13-2005, 11:11 PM
I've run across similar weird quirks doing ActiveSheet.Copy in Excel 2000. I don't know why it sometimes fails for me, but I find ActiveSheet.Cells.Copy to be more reliable. ActiveSheet.Cells picks up everything on the sheet, not just cells. And note that you still use some form of Sheet.Paste, not Sheet.Cells.Paste.

So you can try that and see if it helps. Also, just scanning real quick through your code, it's not clear to me that you even need to copy the sheet since I didn't see a paste anywhere (but I might just be reading it too quick). Good luck!

Zack Barresse
03-14-2005, 10:03 AM
When using something like this ..
Activesheet.Copy.. it's not a traditional copy mehtod. Understand that. It is copying the sheet to a new workbook. That is very, very different from ..
Activesheet.Cells.CopyThis uses the clipboard to copy information onto, a Windows shell object. So you don't need to use Application.CutCopyMode = False after using ws.Copy, as it's not using the clipboard!

BlueCactus
03-14-2005, 10:22 AM
When using something like this ..
Activesheet.Copy.. it's not a traditional copy mehtod. Understand that. It is copying the sheet to a new workbook.

Ah, that might explain a few things. Cheers!

Zack Barresse
03-14-2005, 10:43 AM
Okay, so I took a little deeper look at your code, which I condensed to ..
Private Sub CommandButton1_Click()
'
' ' this macro saves the active sheet to a cell value: (5, 9) = Cell I5
'
Dim oApp As Object, oMail As Object, wb As Workbook, FileName As String
Dim ws As Worksheet, tmpws As Worksheet
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set tmpws = Sheets.Add
tmpws.Range("A1:F369").Copy tmpws.Range("A1")
tmpws.Columns.AutoFit
tmpws.Rows.AutoFit
tmpws.Copy
Set wb = ActiveWorkbook
FileName = Cells(5, 9).Value & " .xls"
'---------------------------------------------------------------------------
On Error Resume Next
Kill "C:\" & FileName
On Error GoTo 0
'---------------------------------------------------------------------------
wb.SaveAs "C:\Documents and Settings\me you\My Documents\" & FileName
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = "someone@somewhere.com"
.Cc = "someone@somewhere.com;someone@somewhere.com"
.Bcc = ""
.Subject = " Please review " & Cells(5, 9).Value
.Body = "I have attached to this email " & Cells(5, 9).Value
.Attachments.Add wb.FullName
.Display
End With
wb.Close False
tmpws.Delete
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub

The one part I don't understand is that between the commented dash-lines. Why not Kill it at the end? Is the point to send an email of only the range copied at the beginning?? Then leave no trace of any temporary sheets created for this??

babycody
03-14-2005, 04:53 PM
Wow a lot of post since I last checked this. I didn't completely fill in the directory for the kill section firefytr. I do want to send a copy of the range at the beginning in an email. I also wanted to save a copy to my hard drive. I have posted my final code below. The main purpose of this was to be able to create a copy completely free of code. That way it could be sent to anyone, and they wouldn't have to enable macros. There are a lot of people out there who aren't even aware you can code in Excel. This keeps me from explaining to them how to adjust their security settings. I am very happy that you took the time to tweak the code. I learn so much from examples like this. This is actually another members code that I have built onto for my own purposes. I linked to his/her post at the beginning. The code below works very well. I haven't had any problems with it so far.
Private Sub CommandButton1_Click()
'
' ' this macro saves the active sheet to a cell value as seen below (5, 10) = Cell J5
'
'Variable declaration
Dim oApp As Object
Dim oMail As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim FileName As String

'Turns off screen updating
Application.ScreenUpdating = False
'adds the date to cell B3
With Range("B3")
.Value = Date
.NumberFormat = "mm/dd/yyyy"
End With
'adds the date to cell J4
With Range("J4")
.Value = Date
.NumberFormat = "mmm-dd-yyyy"
End With

Range("A1:F387").Copy

Sheets.Add

Set ws = ActiveSheet

ws.Range("A1").PasteSpecial Paste:=xlPasteAll

ws.Columns.AutoFit

ws.Rows.AutoFit
ws.Columns("E:E").ColumnWidth = 21
Range("A1:F387").PrintOut 'prints this range

'Makes a copy of the active sheet and save it to
'a folder
Application.CutCopyMode = False
ws.Copy
'Adjust column width of merged cells to compensate for ws.Columns.AutoFit
Columns("E:E").ColumnWidth = 21
Set wb = ActiveWorkbook
'
' '-----------this macro saves the active sheet to a cell value as seen below (5, 10) = Cell J5

FileName = Cells(5, 10).Value & " .xls"
On Error Resume Next
Kill "C:\Documents and Settings\me you\My Documents\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="C:\Documents and Settings\me you\My Documents\" & FileName

'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a To recipient
.To = "someone@somewhere.com"
'Uncomment the line below to hard code a CC recipient
.CC = "someone@somewhere.com;someone@somewhere.com"
'Uncomment the line below to hard code a Bnn recipient
'.Bcc = "someone@somewhere.com"
'Uncomment the line below to hard code a subject
.Subject = " Please review " & Cells(5, 10).Value
.Body = "I have attached to this email " & Cells(5, 10).Value
.Attachments.Add wb.FullName
.Display
ActiveWorkbook.Close
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End With
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub