Excel VBA行复制和粘贴错误

下面的代码是复制和粘贴从Sheet1到Sheet2的行，这取决于在第一个表中列E中遇到的关键字标准。

在代码行5到10之间我试图将整个第十行复制到sheet2以用作此表的列标题，其中将创build一个透视。

当我尝试运行任何操作来复制和粘贴这一行时，我得到“应用程序定义的或对象定义的错误”。

谁能帮忙？

Sub mileStoneDateChanger() Dim r As Long, pasteRowIndex As Long, v() As Long, i As Long Dim lastRow As Long Dim lCol As Long Sheets("Sheet1").Select Rows("10:10").Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.Paste lastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row MsgBox "Last Row: " & lastRow pasteRowIndex = 1 With Sheets("Sheet1") For r = 1 To lastRow If .Cells(r, "E").Value Like "Milestone*" Then If UBound(Split(.Cells(r, "E"), ",")) > 0 Then i = i + 1 ReDim v(1 To i) v(i) = pasteRowIndex End If Sheets("Sheet1").Rows(r).Copy Sheets("Sheet2").Rows(pasteRowIndex) pasteRowIndex = pasteRowIndex + 1 End If Next r End With With Sheets("Sheet2") newLastRow = pasteRowIndex If IsArray(v) Then .Columns(6).Insert shift:=xlToRight For i = 1 To newLastRow If InStr(1, .Cells(i, "E"), ",") Then .Cells(i, "F").Value = Split(.Cells(i, "E"), ",")(1) End If Next i End If End With End Sub 

Answer 1

这里是Sheet1中的第10行到Sheet2中的A1的副本

 Sheets("Sheet1").Rows("10").Copy Sheets("Sheet2").Range("A1") 

Answer 2

用Selection.PastereplaceSelection.PasteSpecial

Answer 3

Range("A1")不能被粘贴一行。 因此，请使用以下内容：

 Sub TestME() Sheets(1).Select Rows("10:10").Select Selection.Copy Sheets(2).Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False End Sub 

免责声明 – 你真的不想在VBA中使用Select和Active 。 如何避免在Excel VBA中使用Select

---

最好的情况可能是避免像这样Copy ：

 Sub TestME() WorkSheets(2).Rows(1) = WorkSheets(1).Rows(10) End Sub