粘贴特殊错误1004 Range类的PasteSpecial方法失败

Posted 2021-04-03

我已经仔细研究了这个问题的当前答案，但没有一个能解决我的问题。

操作只是复制一张纸的选择并复制到一本名为预算的新书。

我再次尝试了多种不同的方法来做同样的事情，但它们似乎都没有改变这个错误。 select方法有效，它只在我尝试粘贴时中断。

码：

Range("B3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Dim wk As Workbook
Set wk = Workbooks.Add

wk.SaveAs FileName:=ThisWorkbook.path & "" & "Budget.xlsx"
wk.Activate
wk.Unprotect
wk.Worksheets("Sheet1").Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

谢谢，

答案

尝试下面的代码（代码中的注释作为注释）：

Dim wk As Workbook
Set wk = Workbooks.Add

wk.SaveAs Filename:=ThisWorkbook.Path & "" & "Budget.xlsx"
wk.Activate
wk.Unprotect

' have the Copy>>Paste section together
Dim LastCol As Long
Dim LastRow As Long

' you never mentioned which sheet to copy from, I used the first index
With ThisWorkbook.Sheets(1)
    LastCol = .Range("B3").End(xlToRight).Column
    LastRow = .Range("B3").End(xlDown).Row
    .Range("B3", .Cells(LastRow, LastCol)).Copy ' <-- Copy without Select
End With

' Paste without Select
wk.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

另一答案

如果您手动尝试完全代码中的步骤，您会发现它也失败了。问题是，在复制单元格并尝试粘贴它们之间，您正在创建一个新工作簿并保存它。这取消了复制/粘贴模式（即复制范围周围的“行进蚂蚁”消失），因此无需粘贴。

解决方案是根本不使用Selection。一般情况下，当你发现自己在VBA中编写.Select时，你做错了（详见this question）。以下是我将重新编写代码的方法：

Dim wk As Workbook

Set wk = Workbooks.Add
wk.SaveAs Filename:=ThisWorkbook.Path & "" & "Budget.xlsx"

ThisWorkbook.Range("B3").CurrentRegion.Copy
wk.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False