将过滤后的范围放入数组 - ....AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(1)

Question

After data is filtered and sorted using Sub CreateFilteredandSort , I'm trying to use

.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(1)

to store the data into an array.

In the array I get only one row.

To get all the data into the array I paste somewhere in the active worksheet then

'Alertnative method
   Range("a1").Select
   ActiveSheet.Paste
   ResultArr = Selection  'This Works fine

What do I correct to prevent the alternative method?

My range data location

Here the source code

Sub TestCreateandClearFilter()

    Dim WS As Worksheet
    Dim ResultArr() As Variant

    Set WS = ActiveWorkbook.ActiveSheet

    IfFilterandSortinWorksheetExistClear WS

    CreateFilteredandSort WS, _
                          WS.Range("Rangedata"), _
                          "H", _
                          "F", _
                          "a", _
                          WS.Range("RNGA")
    'store in Array
    'not Working, Only one row is stored
    ResultArr = WS.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(1)
    WS.Range("Rangedata").Offset(1).SpecialCells(xlCellTypeVisible).Select
    ResultArr = Selection
    'not Working, Only one row is stored
   
    WS.Range("Rangedata").Offset(1).Copy
   
    'Alertnative method
    Range("a1").Select
    ActiveSheet.Paste
    ResultArr = Selection                        'This Works fine
                  
End Sub

Sub CreateFilteredandSort(WS As Worksheet, RangeSelected As Range, _
  FilterField11Name As String, FilterField12Name As String, _
  FilterField12Criteria As String, Group1Sort As Range)
    '
    ' Create Custom Filter and sort Macro
    Dim FilterColumn1 As Variant
    Dim arra As Variant

    'GetTheOffsetField
    '3 required because the range start in column 4
    FilterColumn1 = RangeSelected.Rows(1).Find(What:=FilterField11Name, _
      LookAt:=xlWhole, SearchOrder:=xlByRows).Column - 3
    
    FilterColumn2 = RangeSelected.Rows(1).Find(What:=FilterField12Name, _
      LookAt:=xlWhole, SearchOrder:=xlByRows).Column - 3
    
    '   Create the Filter
    RangeSelected.AutoFilter Field:=FilterColumn1, Criteria1:="TRUE"
    RangeSelected.AutoFilter Field:=FilterColumn2, Criteria1:=FilterField12Criteria
    'Sort by group1
    WS.AutoFilter.Sort.SortFields.Add2 Key:= _
      Group1Sort, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
      :=xlSortNormal
    
    With WS.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Sub IfFilterandSortinWorksheetExistClear(WS As Worksheet)

    If WS.AutoFilterMode Then Selection.AutoFilter

End Sub

Answer 1

Please, try the next function, able to transform a discontinuous range in a continuous array:

Function arrayFromDiscontRange(rng As Range) As Variant
  Dim aR As Range, R As Range, arrInt, arr, i As Long, k As Long
  Dim rngInt As Range, count As Long, j As Long
  
  k = 1
  'counting range/area rows:________________________________
  Set rngInt = Intersect(rng, rng.cells(1, 1).EntireColumn)
  For Each aR In rngInt.Areas
    If aR.rows.count = 1 Then
        count = count + 1
    Else
        For Each R In aR.cells
            count = count + 1
        Next
    End If
  Next
  '________________________________________________________
  ReDim arr(1 To count, 1 To rng.Columns.count)
  For Each aR In rng.Areas
    If aR.rows.count = 1 Then
        For i = 1 To aR.Columns.count
            arr(k, i) = aR.cells(1, i)
        Next
        k = k + 1
    Else
        For i = 1 To aR.rows.count
            For j = 1 To aR.Columns.count
                arr(k, j) = aR.cells(i, j)
            Next j
            k = k + 1
        Next
    End If
  Next
  arrayFromDiscontRange = arr
End Function

It can be called passing a discontinuous range (obtained after filtering), in the next way:

  'firstly, filter the range
  '
  Dim rngArr As Range
  Set rngArr = WS.Range("Rangedata").SpecialCells(xlCellTypeVisible)
  ResultArr = arrayFromDiscontRange(rngArr)
  Dim arrFirstRow
    arrFirstRow = Application.Index(ResultArr, 1, 0) 'make a slice for the first array row (1D array)
    Debug.Print Join(arrFirstRow, "|") 'see the array first row content in Immediate Window

If you need to skip the first row, the function can be easily transformed to create the array starting from the second (real) range row. First row of the first area will be skipped...

Edited :

The next function is able to return an array starting from a mentioned row:

Function arrFromDiscontRange(rng As Range, Optional startRow As Long = 1) As Variant
  Dim aR As Range, R As Range, arrInt, arr, i As Long, k As Long
  Dim rngInt As Range, count As Long, j As Long, iStart As Long
  
  k = 1
  'counting range/area rows:________________________________
  Set rngInt = Intersect(rng, rng.cells(1, 1).EntireColumn)
  For Each aR In rngInt.Areas
    If aR.rows.count = 1 Then
        count = count + 1
    Else
        For Each R In aR.cells
            count = count + 1
        Next
    End If
  Next
  '________________________________________________________
  ReDim arr(1 To count - startRow + 1, 1 To rng.Columns.count)
  For Each aR In rng.Areas
    If aR.rows.count = 1 Then
        iStart = iStart + 1
        If iStart >= startRow Then
            For i = 1 To aR.Columns.count
                arr(k, i) = aR.cells(1, i)
            Next
            k = k + 1
        End If
    Else
        For i = 1 To aR.rows.count
            iStart = iStart + 1
            If iStart >= startRow Then
                For j = 1 To aR.Columns.count
                    arr(k, j) = aR.cells(i, j)
                Next j
                k = k + 1
            End If
        Next
    End If
  Next
  arrFromDiscontRange = arr
End Function

It can be called/tested, in your context in the next way:

  'firstly, filter the range
  '
  Dim rngArr As Range
  Set rngArr = WS.Range("Rangedata").SpecialCells(xlCellTypeVisible)
  ResultArr = arrayFromDiscontRange(rngArr, 2)' it will build the array starting from the second row of the (discontinuous) range.
  Dim arrFirstRow
  arrFirstRow = Application.Index(ResultArr, 1, 0) 'make a slice for the first array row (1D array)
  Debug.Print Join(arrFirstRow, "|") 'see the array first row content in Immediate Window

Please, test it and send some feedback. I had in mind doing such a function and I did it now, seeing your question...