Please can someone edit or give me code that allows the whole row to be copied to completed work sheet based on column Y having 'Yes' in it and deleting the previous row in register once moved, much appreciated
Sub MoveCompletedProjects()
Const sCol$ = "Y" '<< search in col. Y
Const sCrit$ = "Yes" '<< criteria in col. Y
Dim ws As Worksheet, ws1 As Worksheet
Set ws = Sheets("Service Transition Register") '<< source sheet name
Set ws1 = Sheets("Completed Projects") '<< target sheet name
Dim r As Long, L As Long
L = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
ws.AutoFilterMode = False
r = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If WorksheetFunction.CountIf(ws.Range(sCol & ":" & sCol), sCrit) > 0 Then '
ws.Cells(1, sCol).Resize(r).AutoFilter Field:=1, Criteria1:=UCase(sCrit)
ws.Rows(2 & ":" & r).SpecialCells(xlCellTypeVisible).Copy
With ws1.Cells(L + 1, 1)
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
ws.AutoFilterMode = False
End If
Application.ScreenUpdating = True
End Sub
See Question&Answers more detail:
os 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…