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

[josanche]

Bonjour le forum,

J'aurais besoin de votre aide précieuse pour résoudre un problème que j'ai actuellement. Je voudrais une macro qui puissent extraire des données provenant d'autres feuillets pour pouvoir les synthéthiser sur un unique feuillet. En pièce jointe, vous retrouverez le fichier excel dans lequel j'ai pu écrire des commentaires pouvant vous aider à apporter la solution au problème. Tout est écrit sur la feuillet 1 et veuillez cliquer sur la cellule A2 pour commencer la lecture des commentaires.

N'hésitez pas à poser des questions si vous en avez !

Merci d'avance le forum

 

[st007]

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

Bonjour,

peut-on le faire avec formules de ce genre

 

[josanche]

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

Non, je ne souhaite pas de formules. Je désire une macro

 

[PMO2]

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

Bonjour,

Essayez le code suivant à copier dans un module Standard

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

 

[josanche]

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

merciiiiiiiiiiiiiiiii ! Super sympa de votre part !