Transformer les données de plusieurs feuilles en tableau

[phraok]

Bonjour à tous,
Tout nouveau sur ce forum mais je vous lis depuis un petit moment. Je cherche désespérément à réunir les données de plus de 200 onglets de mon classeur en un seul tableau récapitulant tous les valeurs afin de le gérer comme une base de données.

Je joins mon fichier sauf que je l'ai amputé de quelque centaines d'onglets.

J'avais trouvé comme solution bête de copier les cellules pour les coller dans mon tableau et dans la bonne colonne sauf que j'ignore comment incrémenter une ligne dans mon tableau à chaque fin de copie de feuille et continuer sur l'onglet d’après.

Ci dessous la macro trouvé qui s'applique uniquement pour la 1ère feuille:

Sub Macro4()
'
' Macro4 Macro
' Macro enregistrée le 19/10/2011
'

'
Range("G2").Select
Selection.Copy
Sheets("Table").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("F2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("C2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("D2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("G2").Select
ActiveSheet.Paste
Range("E2").Select
Sheets("193").Select
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("E2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("H2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("F12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("I2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("J2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("K2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("L2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("M2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("E15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("O2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("E16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("P2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("E17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("Q2").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
Sheets("193").Select
Range("H14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("R2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("H15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("S2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("H16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("U2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("H17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("V2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("W2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("X2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("Y2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("C28").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("Z2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AA2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("G30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AB2").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=9
Sheets("193").Select
Range("J30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AC2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AD2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D33").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AE2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("F32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AF2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("F33").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AG2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("H32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AH2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("H33").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AI2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("J32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AJ2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("J33").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AK2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("L32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AL2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("L33").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AM2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AN2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("D35").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AO2").Select
ActiveSheet.Paste
Sheets("193").Select
Range("H5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
Range("AP2").Select
ActiveSheet.Paste
End Sub

J'imagine qu'il doit y avoir une solution beaucoup plus élégante c'est pourquoi je m'en remet à vous


Merci par avance!

 

[job75]

Re : Transformer les données de plusieurs feuilles en tableau

Bonjour phraok,

J'imagine qu'il doit y avoir une solution beaucoup plus élégante (...)

Evidemment, une macro de 296 lignes avec des Select Copy Paste partout...

Ce qui aurait été élégant c'est de prévoir des onglets facilement exploitables, c'est à dire présentés en tableaux dont les données se succèdent dans l'ordre du tableau de synthèse.

Perso pas trop envie d'aller à la pêche de toutes ces cellules

Enfin, si j'ai le temps...

A+

 

[TempusFugit]

Re : Transformer les données de plusieurs feuilles en tableau

Bonjour

Essaie cette méthode

Sub MacroTest()
Dim i As Long, j As Long, k As Long
Dim ADRESSE_CELLULES, a As Range
ADRESSE_CELLULES = Array("G2", "J2", "D5", "C7", "C9", "B5") 'ici ajouter le reste des cellules qui t'intéressent
k = 2
For j = 2 To Sheets.Count
Set a = Sheets("Table").Cells(k, "A")
For i = 0 To UBound(ADRESSE_CELLULES)
a.Offset(0, i) = Sheets(j).Range(ADRESSE_CELLULES(i))
Next i
k = k + 1
Next j
Set a = Nothing
End Sub

Cela fonctionne si tu renommes tes feuilles (pas le nom des onglets) mais ce qu'on appelle le code name (Il faut aller pour cela dans Microsoft Visual Basic Editor)

J'ai renommé la feuille Table qui avait comme code name Feuil193 en Feuil1.

 

[phraok]

Re : Transformer les données de plusieurs feuilles en tableau

Pouaaah !!!, merci beaucoup TempusFugit, ça marche vraiment bien !!!! et merci à Job75 également !

 

[Dranreb]

Re : Transformer les données de plusieurs feuilles en tableau

Bonjour.

Sub RapatrierFeuilles()
Dim L As Long, FBDD As Worksheet, F As Worksheet
Set FBDD = Worksheets("Table")
L = 1
For Each F In Worksheets
   If F.Name <> FBDD.Name Then
      L = L + 1
      FBDD.Cells(1, L).Value = F.[G2].Value
      FBDD.Cells(2, L).Value = F.[J2].Value
      FBDD.Cells(3, L).Value = F.[D5].Value
      ' etc. etc.
      End If
   Next F
End Sub

Vous auirez tout intérêt à n'avoir qu'une seule fiche, à l'avenir, permettant de présenter sous cette forme une ligne de la table. L'écriture d'une macro assurant la communication entre la liste et la fiche serait grandement facilitée par des noms de plages très courts aux champs de la fiche commancant par "f_" par exemple et aux colonnes correspondantes dans la liste commancant par "c_" par exemple, le reste étant commun.
À +

 

[phraok]

Re : Transformer les données de plusieurs feuilles en tableau

Merci Dranreb, oui l'intérêt d'une fiche unique est évident mais mes prédécesseur ne le voyaient pas de la même manière. Pour la suite il me reste à créer un formulaire PDF à lier avec cette base (je ferai des recherches) afin d'éditer et de maintenir à jour cette fiche facilement.
Merci beaucoup vous êtes géniaux =)

 

[job75]

Re : Transformer les données de plusieurs feuilles en tableau

Re, salut Bernard

Bon j'ai été taquiner le gardon.

La macro fait 19 lignes mais j'ai créé la liste des adresses des 42 (-2) cellules

Sub Copie() 'se lance par Ctrl+A
Dim liste$, ad, ub As Byte, tablo(), w As Worksheet, i&, j As Byte
liste = "G2,J2,D5,C7,C9,B5,E9,B12,F12,C14,C15,C16,C17,,E15,E16,E17,H14,H15,,H16,H17,D19,C25,C27,C28,D30,G30,J30,D32,D33,F32,F33,H32,H33,J32,J33,L32,L33,D34,D35,H5"
ad = Split(liste, ",")
ub = UBound(ad)
'---création et remplissage de tablo---
ReDim tablo(Worksheets.Count - 2, ub)
For Each w In Worksheets
  If w.Name <> "Table" Then
    For j = 0 To ub
      If ad(j) <> "" Then tablo(i, j) = w.Range(ad(j))
    Next
    i = i + 1
  End If
Next
'---restitution des valeurs sur la feuille---
With Sheets("Table")
  .[2:65536].ClearContents
  If i Then .[A2].Resize(i, ub + 1) = tablo
End With
End Sub

Fichier joint.

Edit : salut aussi à TempusFugit dont je n'avais pas vu le post.

A+