Question

我在这里有一些代码可以动态过滤每天增长的大集合中的所有数据，然后在月初重置，选择我过滤的内容，复制它并将其粘贴到另一个文件中。同样，它的动态之处在于列表的大小并不重要。第1行有一个标题行。但是，这段代码不是最佳的，因为它充满了激活和选择。我不知道如何在不使用剪贴板和不使用select的情况下重写它。这是代码。

    Workbooks(DataFileName).Activate
    Sheets(twtsumdivdata).Activate
                On Error Resume Next
    ActiveSheet.ShowAllData
    ActiveSheet.Rows("1:1").AutoFilter Field:=shopcol1, Criteria1:=Application.Transpose(FilterRange2), Operator:=xlFilterValues
    ActiveCell.Offset(1, 0).Select
    Do Until ActiveCell.Height <> 0
    ActiveCell.Offset(1, 0).Select
                Loop
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(ShopFileName).Activate
    Sheets(twtsumdivsheet).Range(target2).Paste
    Application.CutCopyMode = False

这是我尝试过的东西，但没有运气。我需要捕获已过滤的整个数据集并将其放在另一个工作簿中。

Dim Src As Range, Dst As Range
Worksheets(twtsumdivdata).Rows("1:1").AutoFilter Field:=shopcol1,   Criteria1:=Application.Transpose(FilterRange2), Operator:=xlFilterValues

Set Src = Workbooks(DataFileName).Worksheets(twtsumdivdata).Range("A2").End(xlDown, xlRight).Value
Set Dst = Workbooks(ShopFileName).Worksheets("Sheet1").Range("A1").Resize(Src.Rows.Count, Src.Columns.Count)
Dst.Value = Src.Value

另一个想法是尝试在过滤后抓住所有可见细胞。我仍然有点不确定我是怎么做到的。

Answer 1

从第.Value行删除Set Src = Workbooks...可能会解决问题。但我宁愿这样做：

Dim Src As Range, Dst As Range
Worksheets(twtsumdivdata).Rows("1:1").AutoFilter Field:=shopcol1, Criteria1:=Application.Transpose(FilterRange2), Operator:=xlFilterValues

Set Dst = Workbooks(ShopFileName).Worksheets("Sheet1").Range("A1")
Set Src = Workbooks(DataFileName).Worksheets(twtsumdivdata).UsedRange
Src.SpecialCells(xlCellTypeVisible).Copy Destination:=Dst

这将以相同的格式复制包括标题行的所有可见单元格。

如果您只想复制没有标题行的数据，请将最后一行替换为：

Intersect(Src, Src.Offset(1)).SpecialCells(xlCellTypeVisible).Copy Destination:=Dst

使用更改的范围优化复制和粘贴代码

1 个答案: