修改VB代码以剪切并粘贴到另一个工作表

时间:2015-02-09 12:44:28

标签: vba

我有以下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

提前感谢您提供的任何帮助。

1 个答案:

答案 0 :(得分: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