Vba 尝试使用最佳做法复制和粘贴筛选的数据

我正在编写一段非常简单的代码，将数据从一个工作簿移动到另一个工作簿。我试图避免使用选择和复制粘贴，因为它被广泛认为不是最佳的。好的，接受挑战。我已经写了几乎所有的东西，我突然意识到-我不知道如何定义一个过滤数据范围作为一个范围，忽略过滤掉的部分。我做了一些搜索，但我不太清楚。现行代码如下：

Sub CSReport()


Dim CabReport As Workbook
Dim ExCashArchive As Workbook

Dim CABReconFilePath As String

Dim ExCashPath As String


Dim HoldingsTabName As String
Dim IMSHoldingsTabName As String

Dim HoldingsTab As Worksheet
Dim IMSHoldingsTab As Worksheet


Dim LastRowHoldings As Integer
Dim LastRowIMSHoldings As Integer


Dim RngHoldings As Range
Dim RngIMS As Range


Dim dt As Date

        dt = Range("Today")
         'Today is a named range with the date, just incase I need to be manually changing it

        CABReconFilePath = Range("CABReconFilePath")
               ExCashPath = Range("ExcessCashArchiveFilePath")
        'What are the files we care about


        HoldingsTabName = Range("HoldingTieOutTabName")
        IMSHoldingsTabName = Range("IMSHoldingsTabName")
        'What are the tab names we care about



         Workbooks.Open Filename:=CABReconFilePath
         Set CabReport = ActiveWorkbook



          Workbooks.Open Filename:=ExCashPath
          Set ExCashArchive = ActiveWorkbook
          'Opening and defining the workbooks we're dealing with



          HoldingsTab = ExCashArchive.Sheets(HoldingsTabName)
          IMSHoldingsTab = ExCashArchive.Sheets(IMSHoldingsTabName)
          'Defining the tabs

          LastRowHoldings = HoldingsTab.Range("A" & Rows.Count).End(xlUp).Row
          LastRowIMSHoldings = IMSHoldingsTab.Range("A" & Rows.Count).End(xlUp).Row
        'Defining the edges of the data
    'Filter goes here
          RngHoldings = HoldingsTab.Range("A3:K" & LastRowHoldings)
          RngIMS = IMSHoldingsTab.Range("A3:P" & LastRowIMSHoldings)
          'Or maybe it goes here?



    CABReconFilePath.Sheets("Holdings_TieOut").Range("A3").Resize(CopyFrom.Rows.Count).Value = RngHoldings.Value
    CABReconFilePath.Sheets("IMS_Holdings").Range("A3").Resize(CopyFrom.Rows.Count).Value = RngIMS.Value
'Getting the values in

    CABReconFilePath.Sheets("Recon Summary").Range("B1").Value = Text(dt, "MM/DD/YYYY")
'And setting the date manually, just incase we're running prior/future reports



ExCashArchive.Close savechanges:=False
CabReport.SaveAs Filename = CABReconFilePath & Text(dt, "MM.DD.YY")
CabReport.Close



End Sub

现在，我之前所做的是相当笨拙的事情，比如：

 Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$W$71").AutoFilter Field:=1, Criteria1:="=*1470*", Operator:=xlFilterValues
    Selection.Copy
  CABReconFilePath.Sheets("CS").Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

到目前为止，这一直是我的方法“过滤数据，复制数据，粘贴到其他地方”-但我正在尝试学习更好的编程方法，我不断听到“不要使用选择”和“尽量避免复制粘贴-将内容移动到一个范围内，然后使用它！”。但我被困在这一点上

---

编辑：.SpecialCells（xlCellTypeVisible）是我需要添加的限定符

您的筛选条件有多复杂？使用自动筛选并不是一个糟糕的想法，但如果您有一个整洁的方法知道如何处理您的条件，我会使用数组。将范围更改为数组，在数组中执行所有操作，一旦最终数组准备就绪，就用一行粘贴它。这是最快最干净的方式。没有选择或模仿使用UI的方法，我想知道一种更好的应用过滤器的方法！你没有回答我的问题，你的标准有多复杂？如果您知道列，并且知道不会经常更改的条件，那么编写VBA代码是有益的。定义数据范围，然后将范围转储到数组中，在数组中执行过滤和操作，创建结果数组，并将数据从数组传输到可以在任何工作簿或工作表中的范围。这非常简单，但只要您没有明确的问题定义，在代码方面很难帮助你。把你需要对示例/数据和预期结果做的事情放在一起非常简单-范围总是相同的，标准总是相同的。假设第一列中有A、B或C，我只想选择A和B。

    Sub CopyFilterRange()
        Dim i As Long
        Dim j As Long
        Dim lRow As Long
        Dim cnt As Long
        Dim UB1 As Long
        Dim UB2 As Long
        Dim rng1 As Range
        Dim rng2 As Range
        Dim arr1() As Variant
        Dim arr2() As Variant
        Dim WS1 As Worksheet
        Dim WS2 As Worksheet

        Set WS1 = ThisWorkbook.Sheets("Sheet1")
        Set WS2 = ThisWorkbook.Sheets("Sheet2") 'this can be a different sheet in a different workbook

        'Find last row in column A
        With WS1
            lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

        'Define range
        Set rng1 = WS1.Range("A1:A" & lRow)

        'Define array out of range
        arr1 = rng1

        'Redim array 2 rows based on the columns of array 1
        'We will define it with one column and rows equal to the same number of columns in array 1
        'The reason is that in arrays only the last index can be flexible and the other indices should stay fixed
        UB1 = UBound(arr1, 1)
        UB2 = UBound(arr1, 2)
        ReDim arr2(1 To UB2, 1 To 1)

        'Loop throug arr1 and filter
        cnt = 0
        For i = 1 To UB1
            For j = 1 To UB2
                If arr1(i, j) = "A" Or arr1(i, j) = "B" Then
                    cnt = cnt + 1
                    ReDim Preserve arr2(1 To UB2, 1 To cnt) 'here we can add one column to array while preserving the data
                    bResizeArray = False 'resizing array should happen only once in the inner loop
                    arr2(j, cnt) = arr1(i, j)
                End If
            Next j
        Next i

        'Transpose arr2
        arr2 = TransposeArray(arr2)

        'Paste arr2 value in the destination range
        'Define the size of destination range
        Set rng2 = WS2.Range("A1")
        Set rng2 = rng2.Resize(UBound(arr2, 1), UBound(arr2, 2))
        rng2.Value = arr2
    End Sub

    Public Function TransposeArray(myarray As Variant) As Variant
        Dim X As Long
        Dim Y As Long
        Dim Xupper As Long
        Dim Yupper As Long
        Dim tempArray As Variant
        Xupper = UBound(myarray, 2)
        Yupper = UBound(myarray, 1)

        ReDim tempArray(1 To Xupper, 1 To Yupper)
        For X = 1 To Xupper
            For Y = 1 To Yupper
                tempArray(X, Y) = myarray(Y, X)
            Next Y
        Next X
        TransposeArray = tempArray
    End Function