Code:Sub ArchiveCompleted() Dim rng As Range With Worksheets("TASKS") For Each rng In .Range("E5:E" & Application.Max(.Cells(.Rows.Count, "E").End(xlUp).Row, 5)) If LCase(rng.Value) = "completed" Then With Worksheets("ARCHIVE") .Cells(.Rows.Count, "B").End(xlUp)(2).Resize(, 2).Value = Array(rng.Offset(, -3).Value, rng(1, 2).Value) rng.Offset(, -3).Resize(, 5).ClearContents End With End If Next rng With .Range("B5:B" & Application.Max(.Cells(.Rows.Count, "B").End(xlUp).Row, 5)) .SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End With End Sub




Reply With Quote
Bookmarks