VBA错误1004：范围类的PasteSpecial方法失败
我现在使用的任何一种粘贴方法都有点麻烦。 从一张纸上的数据必须剪切和粘贴到另一张，但我不知道我错过了什么。
错误发生在这里，在评论“HERE”之后不久：
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 完整的代码可以在下面find，感谢任何答复。
Option Explicit Public Sub Workbook_Open() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim wb As Variant Dim wsName As Variant Dim blastrow As Variant Dim flastrow As Variant Dim lastrow As Variant ActiveWorkbook.Sheets("combined").Select Range("A1:U9999").ClearContents Dim MyObj As Object, MySource As Object, file As Variant file = Dir("G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\") 'file level loop While (file <> "") If InStr(file, ".xlsx") > 0 Then Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\" & file wb = ActiveWorkbook.Name 'ws = ActiveSheet.Name Dim ws As Worksheet 'worksheet/tab level loop For Each ws In ActiveWorkbook.Worksheets ws.Activate wsName = ws.Name 'andrew code (09/12/2015) blastrow = Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1 If blastrow = 2 Then blastrow = 1 Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & blastrow & ":XFD" & blastrow).Value = _ Workbooks(wb).Worksheets(wsName).Range("A1:XFD1").Value lastrow = Range("A" & Rows.Count).End(xlUp).Row 'finding status column Range("M1").Select Do Until ActiveCell.Value = "Status" Or ActiveCell.Column > 100 If Range("A2") = "" Then GoTo there End If ActiveCell.Offset(0, 1).Select Loop 'looping through Do Until ActiveCell.Row > lastrow If ActiveCell.Value = "Solved" Then 'HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! wb = ActiveWorkbook.Name wb = Replace(wb, ".xlsx", "") ActiveCell.EntireRow.Cut Workbooks("copy of merge.xlsb").Activate 'find matching company Range("E1").Select While ActiveCell.Value <> "CoName" ActiveCell.Offset(0, 1).Select Wend Do Until ActiveCell.Value = wb ActiveCell.Offset(1, 0).Select If ActiveCell.Value = "" Then ActiveCell.EntireRow.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If Loop 'first cell in row select ActiveSheet.Cells(ActiveCell.Row, 1).Select 'find matching ws If ws = "Be Wiser" Then Do Until ActiveCell.Value = "BW" ActiveCell.Offset(1, 0).Select Loop ElseIf ws = "Insure Wiser" Then Do Until ActiveCell.Value = "IW" ActiveCell.Offset(1, 0).Select Loop ElseIf ws = "Call Wiser" Then Do Until ActiveCell.Value = "CW" ActiveCell.Offset(1, 0).Select Loop ElseIf ws = "Quote Wiser" Then Do Until ActiveCell.Value = "QW" ActiveCell.Offset(1, 0).Select Loop ElseIf ws = "Be Wiser Business" Then Do Until ActiveCell.Value = "BWB" ActiveCell.Offset(1, 0).Select Loop ElseIf ws = "Younger But Wiser" Then Do Until ActiveCell.Value = "YBW" ActiveCell.Offset(1, 0).Select Loop End If 'insert row and paste Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1 'Range("A" & lastrow).Select 'ActiveSheet.Paste ws.Activate lastrow = Range("A" & Rows.Count).End(xlUp).Row Cells.Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A19" _ ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:U" & lastrow) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("M1").Select Do Until ActiveCell.Value = "Status" Or ActiveCell.Column > 100 ActiveCell.Offset(0, 1).Select Loop Else ActiveCell.Offset(1, 0).Select End If Loop there: 'here flastrow = Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row If blastrow = flastrow Then Workbooks("Copy of merge.xlsb").Worksheets("Combined").Activate Range("A" & blastrow).Select ActiveCell.EntireRow.Delete Workbooks(wb).Worksheets(wsName).Activate End If Next ws Workbooks(wb).Close False End If file = Dir Wend Call storeFileNames Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
正如已经指出的，你应该重写这个，但作为一个快速修复，添加一个范围variables：
Dim rgCut as Excel.Range
那么而不是这个：
ActiveCell.EntireRow.Cut
使用：
set rgCut = ActiveCell.EntireRow
然后取代这个：
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
有了这个：
rgCut.Cut Destination:=Selection.Cells(1)