Code returning error '1004'

I picked up some code from 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:

Code:

---

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:

Why are you selecting Sheet1 anyway?

Code:

---

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

---

Quote:

---

Originally Posted by Norie

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.

Quote:

---

Originally Posted by babycody

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.

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. :)

On MrExcel it will only be text and you can't edit a message after a certain time period.

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.

Actually I'm not sure if there is a limit now. There definitely used to be but perhaps it's changed.

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.

Is there anything different going on elsewhere when it fails?

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. :)

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!

When using something like this ..

Code:

---

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 ..

Code:

---

Activesheet.Cells.Copy

---

This uses the clipboard to copy information onto, a Windows shell object. So you don't need to use

Code:

---

Application.CutCopyMode = False

---

after using ws.Copy, as it's not using the clipboard!

Quote:

---

Originally Posted by firefytr

When using something like this ..

Code:

---

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!

Okay, so I took a little deeper look at your code, which I condensed to ..

Code:

---

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??

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.

Code:

---

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

---