Filter data and copy visible cells based on criteria

Originally Posted by YasserKhalil

Thanks a lot for this wonderful help ..
By the way how can I say (Bear with me ..) I mean ...

You are welcome.
Yes, I know
It has been a while since I am being involved in some of your threads. I just made a joke to make it not too boring.
The bear, I mean, like the grizzly bear, polar bear, ....

-----

One way is to save the filtered rows of AutoFilter to a variable (in my code below it is called filteredRows), and then you can use this var as many time as needed, together with intersect method, to get intersection area of expected columns.

Sub Test()
  Dim arrRngA(1 To 3) As Range, arrRngB(1 To 3) As Range, filteredRows As Range
  Dim i As Long, total As Long

  Application.ScreenUpdating = False

  For i = 1 To UBound(arrRngA)
      Set arrRngA(i) = Worksheets("0" & i & "A").Range("C6")
      Set arrRngB(i) = Worksheets("0" & i & "B").Range("AE6")
      arrRngA(i).Resize(1000, 10).ClearContents  '.Resize(1000, 10) = 1000 rows x 10 columns (C:L)
      arrRngB(i).Resize(1000).ClearContents
      arrRngA(i).Parent.Visible = xlSheetVeryHidden
      arrRngB(i).Parent.Visible = xlSheetVeryHidden
  Next i

  With Sheets("Data")
    .AutoFilterMode = False
     With .Range("B1").CurrentRegion
       .AutoFilter field:=3, Criteria1:=.Parent.Range("I1").Value
        With .Columns(1).Offset(1).SpecialCells(xlCellTypeVisible)
          total = .Count
          Set filteredRows = .EntireRow
        End With
     End With
    .AutoFilterMode = False
  
    If total >= 2 Then
       arrRngA(1).Parent.Visible = xlSheetVisible
       Intersect(filteredRows, Sheet1.Columns("B")).Copy arrRngA(1)
       Intersect(filteredRows, Sheet1.Columns("V:X")).Copy arrRngA(1).Offset(0, 1)
       Intersect(filteredRows, Sheet1.Columns("P:U")).Copy arrRngA(1).Offset(0, 4)

       arrRngB(1).Parent.Visible = xlSheetVisible
       Intersect(filteredRows, Sheet1.Columns("K")).Copy arrRngB(1)
    Else
       Exit Sub
    End If
  End With

  For i = 1 To (UBound(arrRngA) - 1)
      With arrRngA(i).Offset(29).Resize(1000, 10)
        If Not IsEmpty(.Cells(1)) Then
           .Copy arrRngA(i + 1)
           .ClearContents
           arrRngA(i + 1).Parent.Visible = xlSheetVisible
        Else
           Exit For
        End If
      End With
      With arrRngB(i).Offset(29).Resize(1000)
        .Copy arrRngB(i + 1)
        .ClearContents
        arrRngB(i + 1).Parent.Visible = xlSheetVisible
      End With
  Next i

  If total > 29 * UBound(arrRngA) Then MsgBox "Not enough sheets to divide data properly"
  Application.ScreenUpdating = True
End Sub