Question

我有以下公式搜索包含文字＆＃39;已完成＆＃39;的行。在collumn C on＆＃39; Live and pipeline＆＃39;表。如果满足该条件，请将整行剪切并粘贴到“已完成”状态。工作表在同一工作簿中。此过程后Sheet1中应该没有空行。

目前我正在Application Run time error 1004, Application defined or object defined error上线Selection.Cut Shift:=xlUp。整个代码在Module1中。谁能告诉我这里出了什么问题？

Sub Completed_Projects()
'
' Move completed projects to the Completed Tab
'
'   Search until an empty cell is reached
Dim Row As Integer
Row = Range("Total_Completed").Row
Dim SumRow As Integer

Application.ScreenUpdating = False
For Each Cell In ActiveSheet.Range("C8:C100").Cells
    If Cell.Value = "Completed" Or Cell.Value = "Aborted" Then
       Rows(Cell.Row).Select
       Selection.Cut Shift:=xlUp

       ' Paste Selection
       Reference = "A" & Row
       Application.Goto (ActiveWorkbook.Sheets("Completed").Range(Reference))
       Range(Reference).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
       ActiveSheet.Paste

       ' Update Counters and go back to Live sheet
       Sheets("Live and pipeline").Select
       Row = Row + 1
    End If
Next Cell
       Application.ScreenUpdating = True 
'
End Sub

Answer 1

这个怎么样？我已经清理了一些代码。

Sub Completed_Projects()
    Dim rw As Integer, counter As Integer

    counter = Range("Total_Completed").Row

    Application.ScreenUpdating = False
        For rw = 100 To 8 Step -1
            If Worksheets("Live and Pipeline").Range("C" & rw) = "Completed" Or Worksheets("Live and Pipeline").Range("C" & rw) = "Aborted" Then
                Rows(rw).Copy Destination:=Worksheets("Completed").Range("A" & counter)
                Rows(rw).EntireRow.Delete Shift:=xlUp
                counter = counter + 1
            End If
        Next rw
    Application.ScreenUpdating = True
End Sub

条件剪切并将选定的行粘贴到其他工作表

1 个答案: