Extraire des données provenant d'autres feuillets (Macro)

Const MOT_VALIDE As String = "Moments"  'calage pour trouver les bonnes feuilles

Sub aa()
Dim S As Worksheet
Dim R As Range
Dim Titres As Variant
Dim var As Variant
Dim T()
Dim cpt&
Dim A$
Dim i&
'---
Titres = Array("Variable", "Mean", "Std Deviation", "Median", "Mode", "0% Min", "100% Max")
'---
For Each S In ThisWorkbook.Worksheets
  If InStr(1, S.[a4], MOT_VALIDE) > 0 Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 7, 1 To cpt&)
    var = S.UsedRange
    '---
    A$ = var(2, 1)
    T(1, cpt&) = Mid(A$, InStrRev(A$, " ") + 1)
    '---
    A$ = var(18, 1)
    T(3, cpt&) = Mid(A$, InStrRev(A$, " ") + 1)
    '---
    For i& = 1 To 2
      A$ = Trim(Mid(A$, InStr(1, A$, " ")))
    Next i&
    T(2, cpt&) = Mid(A$, 1, InStr(1, A$, " ") - 1)
    '---
    A$ = var(19, 1)
    For i& = 1 To 2
      A$ = Trim(Mid(A$, InStr(1, A$, " ")))
    Next i&
    T(4, cpt&) = Mid(A$, 1, InStr(1, A$, " ") - 1)
    '---
    A$ = var(20, 1)
    For i& = 1 To 2
      A$ = Trim(Mid(A$, InStr(1, A$, " ")))
    Next i&
    T(5, cpt&) = Mid(A$, 1, InStr(1, A$, " ") - 1)
    '---
    A$ = var(47, 1)
    T(6, cpt&) = Mid(A$, InStrRev(A$, " ") + 1)
    '---
    A$ = var(37, 1)
    T(7, cpt&) = Mid(A$, InStrRev(A$, " ") + 1)
    '---
  End If
Next S
'---
If cpt& = 0 Then Exit Sub
Set S = ThisWorkbook.Sheets.Add(before:=ThisWorkbook.Sheets(1))
Set R = S.Range(S.Cells(2, 1), S.Cells(UBound(T, 2) + 1, UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
'---
Set R = S.Range("a1:g1")
R = Titres
R.Interior.ColorIndex = 34
R.Font.Bold = True
R.HorizontalAlignment = xlCenter
End Sub