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