Discussion :

[sissine]

Bonjour à tous,

J'ai un fichier Excel composé de 130 feuilles. Chaque feuille comporte un tableau de 13 colonnes. Les colonnes sont titrées et toutes les feuilles ont la même trame de tableau mais le contenu diffère.

Comment puis-je fusionner les 130 tableaux dans un seul tableau, et ceci dans une seule feuille.

Merci d'avance pour votre collaboration.

[Supermichou]

Bonjour,

tu souhaites une somme, un empilement de tous les tableaux genres un immeubles de 130 étages ?

Pour 130 plages, l'outils de consolidation peut être un peu long

exemple, pour une somme, tu peux créer un onglet start, un autre stop les placer au début et à la fin de tes onglets et créer un autre onglet tou au début.

exemple
synthèse /start/ong1/ong2/...ong130/stop/

ensuite, tu peux faire cette formule en A2 de l'onglet synthèse

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SOMME(Start:Stop!A2)

qui fera la somme de tous les A2 dans les onglets compris entre les onglets start et stop (compris).

Michel

[Daniel.C]

Bonjour,

Est-ce que tes tableaux ont des libellés dans la colonne de gauche ? des entêtes ? Dans ce cas, envisage la consolidation.
Tu peux faire également faire une totalisation dans une cellule total :
En A1 de la feuille de totalisation, mets :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SOMME(Feuil1:Feuil130!A1)

où Feuil1 est la première feuille et Feuil130 la dernière. Recopie la formule sur la plage à totaliser.

[kiki29]

Salut, pour info voir ici ou là et adapter à ton contexte.

[sissine]

Salut à tous,

Merci beaucoup pour vos réponses. Mais j'ai trouvé des difficultés pour comprendre et mettre en place vos propositions.

@Supermichou et Daniel.C,
Dans A2, j'ai tapé: "=Somme(Table1:Table130!A2)"
Table1 et Table130 étant respectivement les noms de la première et la deuxième feuille.

Ensuite, une fenêtre "Mettre à jours les valeurs : table130" s'ouvre, avec en bas le nom du fichier et le type de fichiers.
Je suis ainsi bloquée et je ne sais pas comment avancer.


@kiki29
Je n'ai pas compris le contenu de ce code et je ne sais pas comment et où est-ce que je dois intégrer le code.

Merci d'avance.

[kiki29]

Salut, le code est à intégrer dans un module standard
[Alt F11] puis menu Insertion/Module
Coller le code dans ce module

Ensuite ajouter la feuille de fusion, si ce n'est pas déjà fait, dont le CodeName est ici ShConcat

Affecter un bouton à la procédure ConcatenationFeuilles sur la feuille de fusion

[Daniel.C]

Bonsoir,

Il faut entrer : "=SOMME(" puis sélectionner l'onglet "Table1", appuyer sur la touche "Maj" et sélectionner l'onglet "Tabl130". Appuie ensuite sur A2, ferme la parenthèse et appuie sur "Entrée". Tu obtiens :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SOMME(Table1:Table130!A2)

Regarde le classeur en pièce jointe.

[sissine]

@kiki29

Merci, j'ai bien commencé à suivre les étapes, mais je suis bloquée ici:

Ensuite ajouter la feuille de fusion, si ce n'est pas déjà fait, dont le CodeName est ici ShConcat

Je ne sais pas comment appliquer ce point.

Merci de m'aider.

@Daniel.C
Merci beaucoup pour votre aide, mais mes tableaux comportent des données et non pas de chiffres, et je cherche plutôt à regrouper l'ensemble de ces données figurantes sur toutes les feuilles dans une seule feuille; ç-à-d si ma 1ère feuille comporte 10 lignes et ma 2ème feuille comporte 5 lignes, la feuille de fusion comportera donc 15 lignes (10 lignes + 5 lignes).

J'espère que j'ai pu éclaircir mon sujet.
Merci d'avance.

[kiki29]

Re, pour le CodeName: les explications via les copies d'écran sont suffisamment claires, le CodeName sur ces copies d'écran est shDonnees.

Sous VBE sélectionner la feuille de fusion dans la fenêtre Projet-VBA Project
puis [F4] pour afficher la fenêtre Propriétés
Eventuellement voir VBE

[kiki29]

Salut,
Ajouter une feuille dont le nom d'onglet sera "Fusion" et le CodeName ShFusion

Créer sur cette feuille 3 boutons "Formulaire" nommés respectivement BtnNettoyage BtnFusion BtnSave
Affecter BtnNettoyage à la procédure Nettoyage
Affecter BtnFusion à la procédure ConcatenationFeuilles
Affecter BtnSave à la procédure SaveFusion
Exécuter la procédure PosBoutons

Le fichier de sauvegarde de la feuille de fusion portera le nom d'onglet de cette feuille càd ici Fusion_yyyymmdd.xls
Si l'on désire un format >= 2007 voir les commentaires dans le code de la procédure SaveFusion

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
 
Dim Dep As Currency
Dim Fin As Currency
Dim Freq As Currency
 
Sub ConcatenationFeuilles()
Dim i As Long, T() As Variant
Dim LastCol As Long, LettreLastCol As String
Dim LettreColMax As String
 
    QueryPerformanceCounter Dep
 
    Application.ScreenUpdating = False
    ShFusion.Cells.Clear
 
    ' Dernère Colonne : dépend de la version d'Excel
    '   256 97-2003  16384 depuis 2007
    LettreColMax = NumCol2Lettre(Application.Columns.Count)
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> ShFusion.Name Then
            ' Dernière Colonne contenant des données
            LastCol = Worksheets(i).Range(LettreColMax & "1").End(xlToLeft).Column
            LettreLastCol = NumCol2Lettre(LastCol)
            Exit For
        End If
    Next i
 
    ' Copie En-Tête
    '   Juste au cas ou la feuille de synthèse se trouverait
    '   en 1ere position
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> ShFusion.Name Then
            With Worksheets(i)
                T = .Range("A1:" & LettreLastCol & "1").Value
                ShFusion.Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
            Exit For
        End If
    Next i
 
    '   Copie des données
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> ShFusion.Name Then
            With Worksheets(i)
                T = .Range("A2:" & LettreLastCol & .Range("A" & Rows.Count).End(xlUp).Row).Value
                ShFusion.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
        End If
    Next i
 
    Erase T
 
    With ShFusion
        .Activate
        With .Cells
            .WrapText = False
            .MergeCells = False
        End With
        .Range("A1").Select
    End With
 
    Application.ScreenUpdating = True
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format((Fin - Dep) / Freq, "0.00000 s")
End Sub
 
Private Function EstVide(Ws As Worksheet) As Boolean
    If Application.WorksheetFunction.CountA(Ws.Cells) = 0 Then
        EstVide = True
    Else
        EstVide = False
    End If
End Function
 
Sub Nettoyage()
Dim Ws As Worksheet
Dim c As Range
Dim iNb As Long, i As Long
 
    ' Nettoyage Chr(10)
    iNb = ThisWorkbook.Worksheets.Count
    i = 0
    QueryPerformanceCounter Dep
 
    Application.ScreenUpdating = False
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> ShFusion.Name Then
            i = i + 1
            For Each c In Ws.UsedRange
                c = Replace(c, Chr(10), "")
            Next c
        End If
        Application.StatusBar = i & " / " & iNb
    Next Ws
    Application.ScreenUpdating = True
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format((Fin - Dep) / Freq, "0.00000 s")
End Sub
 
Private Function NumCol2Lettre(iNumCol As Long) As String
Dim i As Long, sStr As String
    i = iNumCol
    sStr = ""
    Do While i > 0
        sStr = Chr$(((i - 1) Mod 26) + 65) & sStr
        i = (i - 1) \ 26
    Loop
    NumCol2Lettre = sStr
End Function
 
Sub PosBoutons()
Dim T As Range
    With ShFusion
        .Activate
        .Rows(1).RowHeight = 40
 
        Set T = .Cells(1, 2)
 
        With .Buttons("BtnNettoyage")
            .Left = T.Left + 3
            .Top = T.Top + 16
            .Width = 100
            .Height = Rows(1).RowHeight - 20
        End With
 
        With .Buttons("BtnFusion")
            .Left = ShFusion.Buttons("BtnNettoyage").Left + ShFusion.Buttons("BtnNettoyage").Width + 3
            .Top = ShFusion.Buttons("BtnNettoyage").Top
            .Width = ShFusion.Buttons("BtnNettoyage").Width
            .Height = ShFusion.Buttons("BtnNettoyage").Height
        End With
 
        With .Buttons("BtnSave")
            .Left = ShFusion.Buttons("BtnFusion").Left + ShFusion.Buttons("BtnFusion").Width + 3
            .Top = ShFusion.Buttons("BtnNettoyage").Top
            .Width = ShFusion.Buttons("BtnNettoyage").Width
            .Height = ShFusion.Buttons("BtnNettoyage").Height
        End With
    End With
End Sub
 
Sub SaveFusion()
Dim Wkb As Workbook
Dim sDateSauvegarde As String
Dim sCheminDossierSauvegarde As String
Dim sNomFichier As String
Dim LettreColMax As String
 
    If EstVide(ShFusion) = True Then Exit Sub
    sCheminDossierSauvegarde = ThisWorkbook.Path
    LettreColMax = NumCol2Lettre(Application.Columns.Count)
    Application.ScreenUpdating = False
 
    sDateSauvegarde = Format(Now, "yyyymmdd")
    sNomFichier = ShFusion.Name & "_" & sDateSauvegarde & ".xls"
    '   Si Excel >= 2007
    'sNomFichier = ShFusion.Name & "_" & sDateSauvegarde & ".xlsx"
 
    Set Wkb = Workbooks.Add
    ShFusion.UsedRange.Copy Wkb.Worksheets(1).Range("A1")
    Wkb.Worksheets(1).Columns("A:" & LettreColMax).Columns.AutoFit
 
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=sCheminDossierSauvegarde & "\" & sNomFichier, FileFormat:=xlNormal
    '   Si Excel >= 2007
    'ActiveWorkbook.SaveAs Filename:=sCheminDossierSauvegarde & "\" & sNomFichier, _
                          FileFormat:=xlOpenXMLWorkbook
 
    Application.DisplayAlerts = True
    ActiveWindow.Close
 
    With ShFusion
        .Activate
        .Range("A1").Select
    End With
 
    Application.ScreenUpdating = True
    Set Wkb = Nothing
End Sub

Pour une utilisation avec d'autres fichiers de ce genre l'idéal serait de créer
um modèle xlt ou xltm puis d'incorporer au fur et à mesure les feuilles.
Le modèle te demandant à sa première utilisation sa sauvegarde en xls ou xlsm/xlsb tout en restant lui intact.

En partant du fichier fourni en mp, ceci pourrait être utile pour supprimer tes 170 feuilles pour créer ton modèle xlt ou xltm.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub SupprimerFeuilles()
Dim Ws As Worksheet
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> ShFusion.Name Then
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
        End If
    Next Ws
End Sub

PS : ton email ne semble plus accessible pour le moment , le code fourni ci-dessus corrige un bug de la dernière version que je t'ai envoyée ...Désolé

[dudedude]

Bonjour,

J'ai essayé de faire marcher le code mais je n'y arrive pas. Message d'erreur: "Erreur d'execution 1004: La méthode 'Buttons' de l'objet '_Worksheet' a échoué"

J'ai essayé en créant les boutons et aussi sans, juste avec PosBoutons. Cf mon fichier en PJ

Merci beaucoup

Vincent

analyse 3.xlsm