下面的代码是根据第一个工作表E列中满足的关键字条件从sheet1复制和粘贴行到sheet2的。
在代码行5至10之间,我试图将整个第十行复制到sheet2,以便用作此工作表的列标题,其中将创建一个枢轴。
每当我试图运行复制和粘贴这一行的任何操作时,我都会得到“Appliced-定义或对象定义的错误”。
有人能帮忙吗?
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
发布于 2017-11-20 15:58:32
下面是Sheet1中第10行到Sheet2中的A1的副本
Sheets("Sheet1").Rows("10").Copy Sheets("Sheet2").Range("A1")
发布于 2017-11-20 15:55:52
将Selection.Paste
替换为Selection.PasteSpecial
发布于 2017-11-20 15:56:00
不能用一整行粘贴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
。How to avoid using Select in Excel VBA
最好的情况可能是避免这样的Copy
:
Sub TestME()
WorkSheets(2).Rows(1) = WorkSheets(1).Rows(10)
End Sub
https://stackoverflow.com/questions/47395918
复制相似问题