[RÉSOLU] Reports de données dans un tableau selon feuille et critère

[Gen Rose]

Bonjour et bonne 14!

J'ai un document que je tente de rendre maléable pour le traitement de données par TCD.

L'idée est de regrouper les données de mes onglets selon 2 conditions dans un tableau de synthèse.

Il s'agit de trouver la feuille associée à la personne et le mois; les 4 résultats sous le mois peuvent être reportés directement.

Ex.: Dans la feuille syhtese TdS, nous avons un nom en A2 qui se trouve sur la première feuille en A1
En B2 le mois qui se trouve en B3 de la première feuille.
Il s'agit de prendre le résultat en B4:B7(première feuille) et les reporter en C2:F2 de la feuille TdS.​

Ça l'air vraiment simple expliqué comme ça et peut-être que j'ai les idées embrouillées en ce début d'année mais...je bloque.

Sachant que ça sert de base à un TCD, le VBA me semble plus approprié (à cause des cellules vides qui, par formules, ne le sont jamais).

Merci à tout ceux qui prendrons le temps de jeter un coup d'oeil

 

[job75]

Re : [RÉSOLU] Reports de données dans un tableau selon feuille et critère

Re,

Ceci est plus logique car ne dépend pas du contenu des cellules A1 :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim a, tablo(), w As Worksheet, nom$, t, n As Byte, lig&
a = Array("Feuil10", "Feuil11", "Feuil12") 'CodeNames à adapter
If IsError(Application.Match(Sh.CodeName, a, 0)) Then Exit Sub
ReDim tablo(1 To 12 * (Worksheets.Count - UBound(a) - 1), 1 To 6)
With Feuil10 'CodeName à adapter éventuellemnt
  For Each w In Worksheets
    If IsError(Application.Match(w.CodeName, a, 0)) Then
      nom = w.[A1]
      t = Application.Transpose(w.[B1:B73])
      For n = 1 To 12
        lig = lig + 1
        tablo(lig, 1) = nom
        tablo(lig, 2) = Application.Proper(Format("1/" & n, "mmmm"))
        tablo(lig, 3) = t(6 * n - 2)
        tablo(lig, 4) = t(6 * n - 1)
        tablo(lig, 5) = t(6 * n)
        tablo(lig, 6) = t(6 * n + 1)
      Next
    End If
  Next
  .[A2].Resize(lig, 6) = tablo
  .[A2].Resize(lig, 6).Replace 0, "", xlWhole 'facultatif, supprime les 0
  .Range("A" & lig + 2 & ":F" & .Rows.Count).ClearContents
End With
On Error Resume Next 's'il n'y a pas de TCD dans la feuille
Sh.PivotTables(1).PivotCache.Refresh
End Sub

A+