Store Values of specific cells in all sheets in an array

[YasserKhalil]

Hello everyone
In my sample I am trying to store the values of specific cells for all the sheets in an array
This is my try .. i can't use redim preserve to preserve previous values

Sub Test()
    Dim Arr, Temp
    Dim Sh As Worksheet
    Dim Counter As Integer
    Dim I As Integer
  
    For Each Sh In ThisWorkbook.Worksheets
    With Sh
        Counter = Counter + 1
        Arr = Array(.Range("C6").Value, .Range("E6").Value, .Range("G6").Value)
        ReDim Temp(1 To Counter * 3)
        For I = Counter To UBound(Temp, 1)
            Temp(I) = Arr(I - 1)
        Next I
    End With
    Next Sh
End Sub

After that I hope to put the results in another sheet like that
1 4 7 10 13 16 19 22 25 28 31 34
2 5 8 11 14 17 20 23 26 29 32 35
3 6 9 12 15 18 21 24 27 30 33 36
Thanks advanced for help

 

[YasserKhalil]

I could solve the first point

Sub Test()
    Dim Arr, Temp
    Dim Sh As Worksheet
    Dim Counter As Integer
    Dim I As Integer
    ReDim Temp(1 To 12, 1 To 3)
   
    For Each Sh In ThisWorkbook.Worksheets
    With Sh
   
        Counter = Counter + 1
        Arr = Array(.Range("C6").Value, .Range("E6").Value, .Range("G6").Value)
        I = I + 1
        For Counter = 1 To 3
            Temp(I, Counter) = Arr(Counter - 1)
           
        Next Counter
    End With
    Next Sh
    Debug.Print UBound(Temp, 2)
    Debug.Print UBound(Temp, 1)
   
    Range("A9").Resize(UBound(Temp, 2), UBound(Temp, 1)).Value = Arr
End Sub

As for the last line doesn't give me right results

 

[Chihiro]

You need to use transpose and also the array you want to put into cell value is Temp and not Arr.

Range("A9").Resize(UBound(Temp, 2), UBound(Temp, 1)).Value = Application.Transpose(Temp)

Or change your code like so (row and col in temp array switched).

Sub Test()
    Dim Arr, Temp
    Dim Sh As Worksheet
    Dim Counter As Integer
    Dim I As Integer
    ReDim Temp(1 To 3, 1 To 12)
 
    For Each Sh In ThisWorkbook.Worksheets
    With Sh
 
        Counter = Counter + 1
        Arr = Array(.Range("C6").Value, .Range("E6").Value, .Range("G6").Value)
        I = I + 1
        For Counter = 1 To 3
            Temp(Counter, I) = Arr(Counter - 1)
         
        Next Counter
    End With
    Next Sh
 
    Range("A9").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp
   
End Sub

 

[YasserKhalil]

Thanks a lot for great help Mr. Chihiro
Is it possible to compact the code that achieve that task ..?
I am searching for more brief lines that do the task

 

[jindon]

Sub test()
    Dim a, i As Long
    ReDim a(1 To Worksheets.Count)
    For i = 1 To Worksheets.Count
        a(i) = Filter(Sheets(i).[if(mod(column(c6:h6),2),c6:h6,char(2))], Chr(2), 0)
    Next
    Sheets.Add.Cells(1).Resize(3, i - 1) = Application.Transpose(Application.Index(a, 0, 0))
End Sub

 

[YasserKhalil]

That's amazing Mr. Jindon
Thank you very much

Can I exclude specific sheet .. suppose I have extra sheet named "Sheet1" and I need to exclude it ?

 

[jindon]

Alter output sheet as you want

Sub test()
    Dim a, ws As Worksheet, n As Long
    ReDim a(1 To 1000)
    For Each ws In Worksheets
        If ws.Name <> "Sheet1" Then n = n + 1: a(n) = Filter(ws.[if(mod(column(c6:h6),2),c6:h6,char(2))], Chr(2), 0)
    Next
    ReDim Preserve a(1 To n)
    Sheets.Add.Cells(1).Resize(3, n) = Application.Transpose(Application.Index(a, 0, 0))
End Sub

 

[YasserKhalil]

Yes that it is the most great solution .. flexible and very excellent
Thank you very very much for incredible help I received from you
Thanks also to the Great Expert Mr. Chihiro
Best Regards