How to store filtered ranges into array?

In sheet1, I have a large table (non-structured) ranged A1:BY1200. Row 1 contains headers, which is filtered.

I need to store the filtered ranges into an array and write the array data to a different workbook.

My puzzles:

I am not familiar with looping through the filtered range and storing them into array.
I also need the last part to be complete for writing the array data (the filtered range) back to, say, sheet2 starting cell A1.

Other posts suggests the Areas method when looping thru the filtered range for recording into an array.

Note: There are non-adjacent rows in the filtered range.

Sub StoreFilteredRangeInArray()
Dim rCell as Range, rData as Range, rArea as Range
Dim i as Long

with Activesheetset 
set rData = .range("A1").CurrentRegion

Dim rFiltered as Range
rData.autofilter Field:=1, Criteria1:="<>"

with rData
set rFiltered = .offset(1,0).Resize(.Rows.count -1, .Column.count).SpecialCells(xlCellTypeVisible)
end with

Dim myArray() as variant
...(get stuck here)

end with
End Sub

Solution

rFiltered is a non-contiguous range. If you check the address (eg using the debugger), it will contain something like $A$2:$H$9,$A$11:$H$12,$A$16:$H$21. In my example have 3 blocks of data, (row 2-9, row 11-12 and row 16-21).

The data of non-contiguous ranges cannot be copied in one go. Instead, you need to look at every block (in Excel-terms, "area") separately.

You can access the areas of a range using the areas-property of a range. In our example, we have 3 areas in rFiltered. For information: Those areas itself are again ranges, and if a Range is contiguous, it will have exactly one member in areas.

You have now the choice of either creating a complete array holding all data of all areas and write that into your destination sheet in one go, or you copy the areas one by one into the destination.

Version 1: Copy all data into an array.
Problem is that you don't know how many rows you have, and you need that information to dimension your array. Therefore I suggest to loop twice over the areas, first iteration is to get the number of rows, and after that copy the data:

Dim rowCount As Long, area As Range
For Each area In rFiltered.Areas
    rowCount = rowCount + area.Rows.Count
Next
ReDim filteredData(1 To rowCount, 1 To rFiltered.Columns.Count)

Unfortunately, in VBA no command exists to copy all data of an array into another array in one go, so we have to loop over all rows and columns manually:

Dim dataRow As Long
For Each area In rFiltered.Areas
    Dim areaData As Variant, areaRow As Long, col As Long
    areaData = area.Value  ' Copy Area data into temp. Array
    ' Copy temp array into final array
    For areaRow = 1 To UBound(areaData, 1)
        dataRow = dataRow + 1
        For col = 1 To UBound(areaData, 2)
            filteredData(dataRow, col) = areaData(areaRow, col)
        Next col
    Next areaRow
Next

And with that, you can write the final data into your destination sheet in one go:

With ThisWorkbook.Sheets("Sheet2")
    .UsedRange.Clear
    .Range("A1").Resize(UBound(filteredData, 1), UBound(filteredData, 2)) = filteredData
End With

Version 2: Copy data area by area, without using arrays
The code for this is easier, but you will not have an array with all the data.

With ThisWorkbook.Sheets("Sheet2")
    .UsedRange.Clear
    Dim area As Range, destRow As Long
    destRow = 1
    For Each area In rFiltered.Areas
        .Cells(destRow, 1).Resize(area.Rows.Count, area.Columns.Count).Value = area.Value
        destRow = destRow + area.Rows.Count
    Next
End With