CODEWITHSUNDEEP
excelvba
Shaneo
Shaneo

Reputation: 1

Copy and Pasting to a new worksheet

I am using the code below to copy and paste the row to a new worksheet. When testing manually it seems to work but when running macro excel freezes. Basically if column L has the word Completed it shoud copy and paste that row to the Completed worksheet then return and delete the original row (everything with the work completed should be moved to completed folder)

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

Upvotes: 0

Views: 37

Answers (1)

Kalicharan.N
Kalicharan.N

Reputation: 132

I used, excel filter and copy, filter and delete option to accomplish the work. Please have a look at the below code.

Logic I used here is- Filter 12th column with value 'Completed'-> Insert the filtered rows into target sheet, starting after last used row -> Delete all the Completed rows in source sheet -> Remove the filter in source sheet

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

Upvotes: 1

Related Questions