Trying to copy and paste filtered data over using best practices

Question

I'm writing a very simple bit of code to move data from one workbook to another. I'm trying to avoid using select and copy-paste, since it's widely considered to not be optimal. Ok, challenge accepted. I've gotten just about everything written, and I've suddenly realized - I don't know how to define a range of filtered data as a range, ignoring the parts that are filtered out. I've done some searching, but I'm not quite there. Current code as follows:

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

Now, what I've previously done is fairly clumsy things like:

 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

This has been my method until now of "Filter data, copy it, paste it somewhere else" - but I'm trying to learn better programming methods, and I keep hearing about "Don't use select" and "Try to avoid copy-pasting - move stuff into a range and use that instead!". But I'm stuck at this point.

Edit: .SpecialCells(xlCellTypeVisible) is the qualifier I needed to add.

Answer 1

    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