如果列中的任何单元格存在于命名区域COUNTIF中，则复制行

Question

VBA非常新，但确实需要有关此代码的帮助。

因此，如果名称在我的命名范围内(在Lookuptab工作表中(，我想复制Worksheet1中L列中的任何单元格。

到目前为止，我已经有了复制和粘贴的代码，它工作得很好，但由于输入了countif标准，我得到了错误compile error sub function not defined

请帮忙！

谢谢，

我的代码如下：

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If CountIf(Sheets("Lookup").Range("Vendor_Lookup"), Sheets("Sheet1").Cells(i, 12).Value) > 0 Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
Application.CutCopyMode = False

End Sub

Answer 1

CountIf不是VBA的原生版本。您必须通过访问工作表功能

Application.WorksheetFunction.CountIf(......

---

还有几个注意事项：

1. 无需为此帖子Activate任何内容
2. 在循环中复制/粘贴可能很耗时。考虑使用Union收集目标行
3. 您可以使用Range.Find来坚持使用本机VBA函数，而不是使用CountIf

将所有这些结合起来会产生如下结果：

Sub SHELTER_IN_PLACE()
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim lr As Long, i As Long
Dim Target As Range, Found As Range
lr = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
For i = 2 To lr
Set Found = Sheets("Lookup").Range("Vendor_Lookup").Find(ws1.Range("A" & i))
If Not Found Is Nothing Then
If Not Target Is Nothing Then
Set Target = Union(Target, ws1.Range("A" & i))
Else
Set Target = ws1.Range("A" & i)
End If
End If
Set Found = Nothing
Next i
If Not Target Is Nothing Then
lr = ws2.Range("B" & ws2.Rows.Count).End(xlUp).Offset(1).Row
Target.EntireRow.Copy
ws2.Range("A" & lr).PasteSpecial xlPasteValues
End If
End Sub