Question

在发送想法之前，我将先复制一个活动的工作表，但这给了我

“运行时错误'1004'：我们无法复制此工作表”。

我在下面尝试了一些命令来复制工作表，只是行不通：

ThisWorkSheet.Copy ' fist method 
Worksheets("Confirm").Activate 
ActiveSheet.Copy   ' Second mehod
ActiveWorkbook.Sheets("Confirm").Copy ' Third method

所有这些出来的错误和调试是导航到上面的代码的在线。

Sub Mail_ActiveSheet()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the ActiveSheet to a new workbook

ActiveSheet.Copy ' when debug this code come out error
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If
End With

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = Range("F4").Value

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    With OutMail
        .To = Range("B12").Value
        .CC = ""
        .BCC = ""
        .Subject = "Order From " & Range("E8").Value
        .HTMLBody = "<font face=""calibri"" style=""font-size:11pt;"">Dear Collegue, " & "<br><br>" & _
                "Please kindly find the attached new order for " & Range("E8").Value & " above." & _
                "<br><br>" & "Regards <br><br>" & Range("F6").Value & "<br><br>" & _
                "Shop : " & Range("E8").Value & "<br>" & _
                        Range("E9").Value & "<br>" & _
                        Range("E10").Value & "<br>" & _
                        Range("E11").Value & "<br>" & .HTMLBody & "</font>"
        .Attachments.Add Destwb.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

MsgBox "Mail has been sent!"

Set OutApp = Nothing
'Set OutMail = Nothing End Sub

请帮助，谢谢

Answer 1

扩展的.xlsx和.xls之间的差异可能是原因。

.xlsx文件可以包含1 048 576行，而.xls文件只能包含65 536行。
因此，VBA尝试将包含1 048 576的整个工作表复制到只能处理.xls行的65 536工作簿中，并且会出现错误。
您可以决定将A1:A65536本书中的具体范围.xlsx复制到.xls。

Answer 2

我刚刚遇到了相同的错误消息。这似乎很罕见，因为我在网络上找不到其他提及。

该错误发生在我的一位客户的PC上，该客户使用我为他开发的VBA加载项。由于他在另一个国家，我无法直接调查。我建议他重新启动PC（完全重新启动，而不仅仅是关闭并启动），这似乎已经解决了。因此，显然这只是Excel中的一个临时故障。

Answer 3

我遇到了这个错误，理查德指出，这种情况很少见。因此，我想分享我的解决方案。

出现此问题的一种情况是，如果您尝试在Excel中复制隐藏的工作表。要复制它，您需要先取消隐藏。

发送前无法复制Activesheet

3 个答案: