复制并粘贴到新工作表

时间:2020-06-07 01:54:13

标签: excel vba

我正在使用下面的代码将行复制并粘贴到新的工作表中。手动测试似乎可以正常工作,但是运行宏excel时会冻结。基本上,如果L列的单词为Completed,则应将该行复制并粘贴到Completed工作表中,然后返回并删除原始行(所有已完成工作的内容都应移至Completed文件夹中)

Public Sub Completed()

Application.ScreenUpdating = False

    Sheets("BPM-Other").Select
    FinalRow = Range("L11579").End(xlUp).Row
    For x = FinalRow To 2 Step -1
        ThisValue = Range("L" & x).Value
        If ThisValue = "Completed" Then
           Range("A" & x & ":O" & x).Cut
            Sheets("BPM_Other Completed").Select
            nextrow = Range("L10500").End(xlUp).Row + 1
            Range("A" & nextrow).Select
            ActiveSheet.Paste
            Sheets("BPM-Other").Select
            Range("A" & x & ":L" & x).Delete Shift:=xlUp
        End If
     Next x
     Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:1)

我使用excel筛选和复制,筛选和删除选项来完成工作。请看下面的代码。

我在这里使用的逻辑是-筛选值为'Completed'的第12列-> 将已筛选的行插入到目标工作表中,从上次使用的行-> 开始删除源表中已完成的行-> 删除源表中的过滤器

Sub filter()
'specify sheet name
src = "BPM-Other"
tar = "BPM_Other Completed"

'calculating last used rows in both source and target sheet
src_last = Sheets(src).Cells(Rows.Count, "A").End(xlUp).Row
tar_last = Sheets(tar).Cells(Rows.Count, "A").End(xlUp).Row


With Sheets(src)
    .AutoFilterMode = False
    'assuming O is your last column, change as needed
    With .Range("A1:O" & src_last)
        'L is 12th column
        .AutoFilter Field:=12, Criteria1:="Completed"
        'Offset used to ignore the header
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(tar).Range("A" & tar_last + 1)
        'delete the rows
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
End With

'to remove the filter in source sheet
On Error Resume Next
    Sheets(src).ShowAllData
On Error GoTo 0

End Sub