Question

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

该操作只是复制一张工作表并复制到一本名为预算的新书。

我再次尝试了多种不同的方法来做同样的事情，但似乎都没有改变这个错误。 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

谢谢，

Answer 1

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

解决方案是根本不使用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

Answer 2

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

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

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

2 个答案: