조건부 잘라 내기 및 선택한 행을 다른 시트에 붙여 넣기

Question

'라이브 및 파이프 라인'시트의 C 열에 'Completed'텍스트가있는 행을 검색하는 다음 수식이 있습니다. 조건이 맞으면 전체 행을 잘라내어 같은 통합 문서의 '완료'시트에 붙여 넣으십시오. 이 절차 후에 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