search列0，复制到新工作表，并删除行 – 帮助需要

这是我已经有了，它在删除范围内的＃N / A。 我现在正在修改它为包含0的单元格做同样的事情。

Sub DeleteErrorRows() Dim r As Range Set r = Range("B:B").SpecialCells(xlCellTypeConstants, 16).EntireRow r.Copy Sheets("Sheet2").Range("A1") r.Delete End Sub 

谢谢 ：）

Answer 1

尝试这个。 它会自动筛选列，并保留源工作表中具有findMe值的行。 您可以将其设置为0，如同我在示例中或其他您想要的。 它将这些行（标题行除外）复制到目标工作表，然后从源工作表中删除它们。

请注意，这也会在目标工作表中find第一个空行，以便您可以多次运行而不会覆盖已经移动到目标工作表的内容。

 Sub CopyThenDeleteRowsWithMatch() Dim wb As Workbook Dim ws As Worksheet Dim tgt As Worksheet Dim rng As Range Dim lastRow As Long Dim firstPasteRow As Long Dim findMe As String Set wb = ThisWorkbook Set ws = wb.Sheets("Sheet1") Set tgt = wb.Sheets("Sheet2") lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row firstPasteRow = tgt.Range("B" & tgt.Rows.Count).End(xlUp).Row + 1 findMe = "0" Set rng = ws.Range("B1:B" & lastRow) ' filter and delete all but header row With rng .AutoFilter Field:=1, Criteria1:="=" & findMe With .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow .Copy tgt.Range("A" & firstPasteRow) .Delete End With End With ' turn off the filters ActiveSheet.AutoFilterMode = False End Sub 

Answer 2

考虑：

 Sub DeleteZeroRows() Dim r As Range, rTemp As Range, rB As Range Set rB = Intersect(Range("B:B"), ActiveSheet.UsedRange) Set r = Nothing For Each rTemp In rB If Not IsEmpty(rTemp) And rTemp.Value = 0 Then If r Is Nothing Then Set r = rTemp Else Set r = Union(r, rTemp) End If End If Next rTemp Set r = r.EntireRow r.Copy Sheets("Sheet2").Range("A1") r.Delete End Sub