How to Copy Filtered Range To Array?

MarekMarek

The purpose is to open a workbook from SharePoint, set the auto filter, copy filtered range into the existing sheet.

The two longest pieces are opening the workbook and pasting as values.

I want to store the filtered range in the array and then assign this array to the existing worksheet (instead of copy - paste).

I have another module from which I am running all the subs (this is one of them). In that module I am starting with the below.

Public Sub TurnOffFunctionality()
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub

Sub OpenWorkbookWithPopulation()

strFilePath = *Path to the SharePoint*

period = 202009

file = period & "_FR05_GRIR_Population"

strFileName = file & ".xlsb"

Set wbkopen = Workbooks.Open(strFilePath & strFileName, ReadOnly:=True, UpdateLinks:=False)

With Workbooks(file)
    .Worksheets("ERP Extract").AutoFilterMode = False
    .Worksheets("ERP Extract").Range("A1").AutoFilter
    .Worksheets("ERP Extract").Range("A1").AutoFilter field:=17, Criteria1:="Trade"
    .Worksheets("ERP Extract").Range("A1").AutoFilter field:=18, Criteria1:=">" & 90
    .Worksheets("ERP Extract").AutoFilter.Range.Copy
    cockpit = .Worksheets("Cockpit").Range("C6:C12").Value2
End With

With Workbooks("Master_Template_Working")
    .Worksheets("Aged GRNI_Pop").Range("A1").PasteSpecial xlPasteValues
    .Worksheets("Instructions").Range("C38:C44") = cockpit
End With

Workbooks(file).Close SaveChanges:=False

End Sub

VBasic2008

You can try something like this (not tested):

With Workbooks(file)
    With .Worksheets("ERP Extract")
        .AutoFilterMode = False
        Dim Data As Variant
        ' If this doesn't work, use another way.
        Data = .Range("A1").CurrentRegion.Value
    End With
    cockpit = .Worksheets("Cockpit").Range("C6:C12").Value2
End With

Dim ColumnsCount As Long
ColumnsCount = UBound(Data, 2)

Dim i As Long ' Source Rows Counter
Dim j As Long ' Columns Counter
Dim k As Long ' Destination Rows Counter
k = 1 ' account for headers (i = 2 To ...)

For i = 2 To UBound(Data, 1)
    If Data(i, 17) = "Trade" And Data(i, 18) > 90 Then
        k = k + 1
        For j = 1 To ColumnsCount
            Data(k, j) = Data(i, j)
        Next j
    End If
Next i

With Workbooks("Master_Template_Working")
    With .Worksheets("Aged GRNI_Pop").Range("A1")
        .Resize(k, ColumnsCount).Value = Data
    End With
    .Worksheets("Instructions").Range("C38:C44") = cockpit
End With

Collected from the Internet

Please contact [email protected] to delete if infringement.