Vba 使用Excel AdvancedFilter xlFilterCopy附加数据

我有一个函数，可以从数据表复制数据，并将其粘贴到调用它的表中。请参阅下文：

Public Sub Barry()

    Const DATA = "data!a1"
    Const OUTPUT = "a3:c3"
    Const FILTER_VALUE_ADDRESS = "d1"
    Const FILTER_COLUMN = 4

    Dim rCrit As Range, rData As Range

    Set rData = Range(DATA).CurrentRegion
    Set rCrit = rData.Resize(2, 1).Offset(, rData.Columns.Count + 2)
    rCrit(1) = rData(1, FILTER_COLUMN): rCrit(2) = Range(FILTER_VALUE_ADDRESS)
    rData.AdvancedFilter xlFilterCopy, rCrit, Range(OUTPUT)
    rCrit.Clear

End Sub

现在它就像一个魔咒，但是我希望用户能够通过单击指定了宏的按钮多次调用此方法，并在当前工作表中不断添加数据，尽管它们之间有一个空行

---

使用上述方法，我无法确定这是如何实现的。

将此例程分配给按钮：

Public Sub Barry2()

    Const DATA = "data!a1"
    Const OUTPUT = "a3:c3"
    Const FILTER_VALUE_ADDRESS = "d1"
    Const FILTER_COLUMN = 4

    Dim rCrit As Range, rData As Range, rOut As Range

    Set rData = Range(DATA).CurrentRegion
    Set rCrit = rData.Resize(2, 1).Offset(, rData.Columns.Count + 2)
    rCrit(1) = rData(1, FILTER_COLUMN): rCrit(2) = Range(FILTER_VALUE_ADDRESS)

    With ActiveSheet.Range(OUTPUT)
        Set rOut = .Offset(.Item(.Parent.Rows.Count).End(xlUp).Row - .Row + 2)
    End With
    rOut = Range(OUTPUT).Value

    rData.AdvancedFilter xlFilterCopy, rCrit, rOut
    rOut.Delete xlUp

    rCrit.Clear

End Sub

---

注意：在运行此方法之前，汇总表第3行中的三列标题必须存在。

您希望如何允许用户多次使用此方法？我看这里没有问题，你能具体说明一下吗？我在评论中加了这个。问题是，如果我理解正确，当前代码将替换a列和cSo列中a3:c3以下的所有内容，您想保留以前过滤器中的旧数据，并在每次按下按钮时将当前排序中的新数据添加到列表底部？@ScottCraner您已经在一个列表中找到了它。实际上，我撒谎@Excel Hero，因为我必须使用Set rOut=Range（OUTPUT）.Offset（Range（OUTPUT）.CurrentRegion.rows.Count-1）。似乎每次粘贴后都会添加一个空行。猜测路由。删除xlUp不起作用。奇怪的是，额外的换行符受到欢迎（虽然没有要求hehe），但这意味着无法附加额外的数据。如果您想要换行符，这是没有问题的。请告诉我，我会更新的。@BarryBlade请仔细检查。我又买了一次，它的效果和广告上的一样。是的，完全肯定。我们可以试一下插队吗。这是我的理想解决方案，我可以更新我的问题以反映这一点。