为啥 PasteSpecial 方法有时会抛出错误 1004？

Posted 2023-02-24

【中文标题】为啥 PasteSpecial 方法有时会抛出错误 1004？

【英文标题】：Why does PasteSpecial method sometimes throw error 1004?为什么 PasteSpecial 方法有时会抛出错误 1004？

【发布时间】：2020-11-17 09:52:45

【问题描述】：

我想将几个工作表的数据复制到一个工作表中，并从表中复制除第一行以外的所有内容。

PasteSpecial 有时会失败

错误 1004“范围类的粘贴特殊方法失败”

我可以点击“调试”然后重新开始，代码继续复制。当我在整个过程中多次这样做时，我就到了最后。

我尝试了其他粘贴模式，例如.paste，并添加了.activate 和.select 语句。

知道为什么会发生这种行为以及如何解决它吗？

Option Explicit

Sub RunOnAllFilesInFolder()

    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim sht As Worksheet
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Dim LastRowWb As Integer, LastRow As Integer
    Dim eof As Integer
    
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
    
    Set ws = ThisWorkbook.Worksheets("Artikelliste")
    
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
        folderName = fDialog.SelectedItems(1)
    End If
    
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    fileName = Dir(folderName & "\*.*")
    
    LastRow = 2
    
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName
 
        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        Set sht = wb.Worksheets("Tabelle1")
        
        LastRowWb = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
        
        sht.Activate
        sht.Range("A2" & ":" & "AM" & LastRowWb).Copy
        
        ws.Range("A" & LastRow).PasteSpecial Paste:=xlPasteFormats
        ws.Cells(LastRow, 15).Value = fileName

        ThisWorkbook.Save
        LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1

        eApp.CutCopyMode = False
        
        wb.Close SaveChanges:=False 
        Debug.Print "Processed " & folderName & "\" & fileName
        fileName = Dir()
    Loop
    
    eApp.Quit
    Set eApp = Nothing
    Application.DisplayAlerts = True
    
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
    
End Sub

【参考方案1】：

知道为什么会出现这种奇怪的行为以及如何解决它吗？

Excel 有清除剪贴板的奇怪习惯，因此建议不要在复制和粘贴操作之间做任何其他事情

您需要给 Excel 时间在剪贴板上放置数据。尤其是当您尝试循环执行复制粘贴操作时。

试试这个

sht.Range("A2:AM" & LastRowWb).Copy
DoEvents
ws.Range("A" & LastRow).PasteSpecial Paste:=xlPasteFormats

顺便说一句，您可能还想阅读How to avoid using Select in Excel VBA