运行时错误1004工作表的粘贴方法失败（尝试从剪贴板粘贴）
（Excel VBA 2007）。 我得到一个由macros生成的代码错误 – Excel写了代码，所以为什么不运行？
一些背景：在我的VBA应用程序中，我试图复制带格式化数据透视表的工作表，并将其粘贴到新的工作簿中，保持格式化，但不链接到源数据。 一个简单的“粘贴”包括源数据。 具有值和格式的“粘贴特殊”不会生成数据透视表格式。
我发现一个posthttp://blog.contextures.com/archives/2010/09/22/copy-pivot-table-format-and-values/它解释了如何手动做到这一点 – 从剪贴板粘贴。 这工作完成手动。
我logging了一个macros，它生成了以下代码：
Sub PivotCopyPaste() ' ' PivotCopyPaste Macro ' ' Aim: Open a workbook with a pivot table report on the first sheet. ' Create a new workbook and paste the pivot table in, without ' pivot source data, but keeping pivot formatting Workbooks.Open Filename:="\\MyServer\MyFolder\PivotReport.xls" Cells.Select Selection.Copy Workbooks.Add Cells.Select 'I think the line below forces the paste from the Clipboard Application.CutCopyMode = False ActiveSheet.Paste 'ERRORS on this line End Sub 当我按照原样运行时， ActiveSheet.Paste行出现错误：“运行时错误1004：Worksheet类的粘贴方法失败”。
如果我拿出Application.CutCopyMode = False行，macros运行，但它粘贴在源数据（即它仍然是一个活动数据透视表） – 不是我想要的。
我发现了很多这个错误的参考 – 包括http://www.mrexcel.com/forum/excel-questions/387000-runtime-error-1004-a.html 。
他们build议剪贴板可能是空的。 我有在Excel中可见的剪贴板窗格，它显示的东西在那里。
他们build议明确引用旧的和新的表/范围，以便它们可以被variables引用，而不是依赖正确的“活动” – 我试过了，它没有太大的区别（只是改变了文本对象“_Worksheet”的“方法”粘贴失败“的错误消息。
是否有可能做我想做的事情？ 如果是这样，怎么样？ 所有的帮助感激地收到。
{后续：在同一个博客上，Debra提供了一些代码来粘贴数据透视表的数据/格式：我不能粘贴链接 – 没有足够的声望 – 但我已经在我的评论中包含链接到@Rory下面。
这允许我分别粘贴每个数据透视表，但是每个报表上还有其他元素，每次都不同，例如公司徽标，（可选）包含数据透视表filter，标题等的隐藏行。我确实是在“粘贴所有内容在工作表'解决scheme，使我的代码简单！ }
我没有做很多的testing，但是试试这个 – 它应该只是粘贴任何被复制的东西，包括图片，但是把数据透视表作为一个静态的范围，格式如下：
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function CloseClipboard Lib "user32.dll" () As Long Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" ( _ ByVal wFormat As Long, ByVal lpString As String, _ ByVal nMaxCount As Long) As Long Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _ ByVal lpString As Long) As Long Private Declare Function lstrcpy Lib "kernel32.dll" ( _ ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long Sub PasteAsLocalFormula() 'If the clipbaord contains an Excel range, any formula is pasted unchanged, moving sheet and _ cell references to the destination workbook. Dim S As String Dim i As Long, CF_Format As Long Dim SaveDisplayAlerts As Boolean, SaveScreenUpdating As Boolean Dim HTMLInClipBoard As Boolean Dim Handle As Long, Ptr As Long, FileName As String 'Enumerate the clipboard formats If OpenClipboard(0) Then CF_Format = EnumClipboardFormats(0&) Do While CF_Format <> 0 S = String(255, vbNullChar) i = GetClipboardFormatName(CF_Format, S, 255) S = Left(S, i) HTMLInClipBoard = InStr(1, S, "HTML Format", vbTextCompare) > 0 If HTMLInClipBoard Then Handle = GetClipboardData(CF_Format) Ptr = GlobalLock(Handle) Application.CutCopyMode = False S = Space$(lstrlen(ByVal Ptr)) lstrcpy S, ByVal Ptr GlobalUnlock Ptr SetClipboardData CF_Format, Handle ActiveSheet.PasteSpecial Format:="HTML" Exit Do End If CF_Format = EnumClipboardFormats(CF_Format) Loop CloseClipboard End If End Sub
在这里添加这个，因为它是Google为错误“工作表类的粘贴方法失败”提供的第一个StackOverflow链接。
当Excel没有准备好粘贴时，似乎会发生此错误。 当从VBA中将隐藏表格中的一组徽标图像复制到主表单中时，我偶尔会出现错误。 最后，我发现我的代码看起来更加强大，增加了一个
Do While Not Application.Ready: Sleep 10: Loop在.Copy之前立即Do While Not Application.Ready: Sleep 10: Loop ，并且在随后的.Select和.Paste之间Do While Not Application.Ready: Sleep 10: Loop 。 这需要放置
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)在模块的顶部。 在.Copy之后我也有一个DoEvents （按照我之前find的某个build议），这似乎也有帮助。 我没有看到错误，因为，FWIW 🙂
更新 – 我仍然不时有错误，所以我采取了以下的错误陷阱。 TryLogoAgain：标签位于较早的.Copy（未显示）之前，因为它似乎是.Copy失败，导致.Paste失败（一遍又一遍地重试.Paste从来没有工作过）。
On Error Resume Next Worksheets(1).Paste Destination:=Worksheets(1).Range("B1") If Err.Number <> 0 Then Err.Clear: MsgBox "Excel is struggling to copy something, trying again...": Sleep (10): GoTo TryLogoAgain
到目前为止，它一直设法在第二次尝试！ （Excel 2010 btw）