使用变化的范围优化复制和粘贴代码答案

【问题标题】：Optimizing code for copy and pasting with ranges that change使用变化的范围优化复制和粘贴代码
【发布时间】：2018-03-30 18:45:12
【问题描述】：

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

    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

另一个想法是尝试在过滤后抓取所有可见单元格。不过，我仍然有点不确定我会如何做到这一点。

【问题讨论】：

我不相信这是minimal reproducible example。但是对于自动过滤器和可见复制有很多这样的例子，例如stackoverflow.com/questions/11903878/…

标签： excel vba

【解决方案1】：

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

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

【讨论】：