完成后，根据 Y 列中的'Yes'将一行复制到新工作表...Excel 2010

Question

请有人编辑或给我代码，允许根据Y列中的"是"将整行复制到已完成的工作表中，并在移动后删除寄存器中的前一行，非常感谢

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

Answer 1

这是一个基本代码，用于将_copy_Paste从同一工作簿中的一个工作表筛选到另一工作表，然后从第一个工作簿中删除数据。您需要更改工作表，并确保工作表位于包含宏的工作簿中。注释在宏中。如果您的数据超出Col "Y"，请更改"Y"。

'Define your ws variables, change "ThisWorkbook" if sheets are not in the workbook that contains this code
Dim srcws   As Worksheet: Set srcws = ThisWorkbook.Sheets("Sheet1") 'Change sheet names as needed
Dim destws  As Worksheet: Set destws = ThisWorkbook.Sheets("Sheet2")
'Define your range to copy; change "Y" to the last column with data
Set Rng = srcws.Range("A1:Y" & srcws.Range("A" & srcws.Rows.Count).End(xlUp).Row)
With Rng
srcws.AutoFilterMode = False  'Clear sheet of any current filters
.AutoFilter 25, "Yes"    'Filter for "Yes" in Col "Y"
With .Offset(1).SpecialCells(xlCellTypeVisible)  'Offset ensures Header row is not copied. SpecialCells ensures only visible data will be copied
.Copy Destination:=destws.Cells(destws.Rows.Count, 1).End(xlUp).Offset(1)  'paste in destination sheet below all data
.EntireRow.Delete  'Delete visible rows that were copied from Sheet1 
End With
srcws.AutoFilterMode = False        'Clear the filter
End With