修改一個VB代碼以剪切和粘貼到另一個工作表

Question

我有以下的VB，有人幫助我的工作很好，除了我現在需要添加。就目前而言，VB正在查看「C」列，如果它是空白的，它會將「A」&「B」剪切並粘貼到另一個表格中。我想要做的還包括「SHOT10」，「SHOT15」&「SHOT20」。也就是說，如果在「C」欄中也發現了這些內容，那麼它們也應該被切割並粘貼到另一張紙上。

CODE

Sub ClearRange3() 

Dim myLastRow As Long 
Dim i As Long 

Application.ScreenUpdating = False 
Sheets("Absence Line").Select 
' Find last row 
myLastRow = Cells(Rows.Count, "B").End(xlUp).Row 


' Loop through range 
For i = 2 To myLastRow 
If Cells(i, "C").Value = "" Then 
    With Range(Cells(i, "A"), Cells(i, "B")) 
     .Copy 
     find_last_record = Worksheets("Duplicates").Range("A65536").End(xlUp).Row + 1 
     Sheets("Duplicates").Paste Destination:=Sheets("Duplicates").Range("A" & i) 
     .ClearContents 
    End With 
End If 
Next i 

Application.ScreenUpdating = True 
End Sub 

預先感謝任何幫助，您可以提供。

Answer 1

這會適合你，Or是你的朋友。

Sub ClearRange3() 

    Dim myLastRow As Long 
    Dim i As Long 

    Application.ScreenUpdating = False 
    Sheets("Absence Line").Select 
    ' Find last row 
    myLastRow = Cells(Rows.Count, "B").End(xlUp).Row 


    ' Loop through range 
    For i = 2 To myLastRow 
    If Cells(i, "C").Value = "" Or Cells(i, "C").Value = "SHOT10" Or Cells(i, "C").Value = "SHOT15" Or Cells(i, "C").Value = "SHOT20" Then 
     With Range(Cells(i, "A"), Cells(i, "B")) 
      .Copy 
      find_last_record = Worksheets("Duplicates").Range("A65536").End(xlUp).Row + 1 
      Sheets("Duplicates").Paste Destination:=Sheets("Duplicates").Range("A" & i) 
      .ClearContents 
     End With 
    End If 
    Next i 

    Application.ScreenUpdating = True 
    End Sub