XL 2010 consolider plusieurs fichiers

zebanx à dit:

l'approche par des formules est pertinente et... lourde à mettre en place.

Cliquez pour agrandir...

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'---entre la formule du mois---
Cancel = True
Target = "='[TBRH-DRG1-1017.xls]Page'!$J$26"
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'---entre la formule de consolidation---
Cancel = True
Target.FormulaR1C1 = "='[TBRH-DRG1-1017.xls]" & Sh.Name & "'!RC+'[TBRH-DRG2-1017.xls]" & Sh.Name & "'!RC+'[TBRH-DRG3-1017.xls]" & Sh.Name & "'!RC"
'---masque les valeurs zéros---
ActiveWindow.DisplayZeros = False
End Sub

job75 à dit:

Bonjour Ahmed, zebanx, le forum,

Pas tellement... Sans se presser comptons 2 minutes par feuille consolidée, ce qui fera 40 minutes pour les feuilles TB1 à TB20.

Et comme je l'ai dit ce travail est fait une fois pour toutes.

Maintenant pour aller plus vite mettez ce code dans ThisWorkbook :

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'---entre la formule du mois---
Cancel = True
Target = "='[TBRH-DRG1-1017.xls]Page'!$J$26"
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'---entre la formule de consolidation---
Cancel = True
Target.FormulaR1C1 = "='[TBRH-DRG1-1017.xls]" & Sh.Name & "'!RC+'[TBRH-DRG2-1017.xls]" & Sh.Name & "'!RC+'[TBRH-DRG3-1017.xls]" & Sh.Name & "'!RC"
'---masque les valeurs zéros---
ActiveWindow.DisplayZeros = False
End Sub

Ensuite, les 4 fichiers étant ouverts, sur la feuille TB1 du fichier de consolidation :

- double-clic en O3 : la formule du mois est entrée

- sélectionner D8: P22, clic droit : la formule de consolidation est entrée

- sélectionner D24: P25, clic droit : la formule de consolidation est entrée.

Comptons 20 secondes par feuille, cela fera moins de 7 minutes pour les feuilles TB1 à TB20.

Ne pas oublier ensuite d'effacer le code VBA...

Bonne journée.

Cliquez pour agrandir...

zebanx à dit:

Bonjour Job75, Ahmed, le forum

Je finalise quand même la proposition du #8 sur la base d'une problématique de x fichiers à consolider comportant Y tableaux identiques.

Inutile de tout répéter mais :
1. on lance la macro "recup" dans chaque fichier de départ et on enregistre (ajout d'une feuille recap vide dans chacune). La macro "recup" permet de récupérer sur une grille dans toutes les feuilles qui commencent par "DB" toutes les données chiffrées sans formules sur un range "A1:AG60" (modifiable)
2. on lance la macro "alancer" dans le fichier final.

Quelques remarques :
- Tous les chiffres sans formule sont additionnés
- Si vous avez des chiffres sans formule qui ne doivent pas être modifiés, il faudrait prévoir dans la macro "recup" de mettre une condition supplémentaire (par exemple de couleur) afin de ne pas récupérer les données.
- Cela suppose aussi que les cellules à additionner ne comportent pas de formules.
S'il faut additionner des formules portant sur des chiffres, il faudra compléter le code toujours en pensant pour ne pas tout prendre (ex : sous-totaux) à une condition de couleur / format.
- J'ai rencontré un problème sur des cellules fusionnés (TB13), donc les chiffres en bleus ont été modifiés et ce sont désormais des textes (S1 pour structure 1 à la place du chiffre "1" fusionné sur 2 cellules).
- il faut que les fichiers soient dans le même répertoire, que les feuilles de récupération sur les fichier de départ s'appellent "recap", que le fichier de consolidation s'appelle "conso" (à vous de modifier les codes le cas échéant.

Après, ça fonctionne bien (sauf erreur).

Un grand merci 😉à Laetitia 90 (et à Staple1600 pour ses remarques pertinentes!) qui m'a aidé sur un code d'additions par dictionnaire.

Je mets 2 zip, l'un sur les fichiers de travail pour préparer les macros, l'autre sur vos fichiers.

Cdlt
zebanx

Cliquez pour agrandir...

BISSON Nicole à dit:

Bonsoir,

Pour la consolidation finale, une méthode classique qui fonctionne aussi sur MAC (sans dictionary)

Code:

Sub SousTotalTabloTrié()
  [G1].CurrentRegion.Sort , key1:=[H2], key2:=[I2], Header:=xlYes
  TblE = Range("G2:J" & [G65500].End(xlUp).Row)
  Dim TblS(): ReDim TblS(1 To UBound(TblE), 1 To UBound(TblE, 2))
  i = 1: n = 0
  Do While i <= UBound(TblE)
    n = n + 1
    clé1 = TblE(i, 2): clé2 = TblE(i, 3)                         ' clés de regroupement
    For c = 1 To 3: TblS(n, c) = TblE(i, c): Next c     ' recopie des 3 premières colonnes
    Do While TblE(i, 2) = clé1 And TblE(i, 3) = clé2
      TblS(n, 4) = TblS(n, 4) + TblE(i, 4)                    ' totalisation colonne numérique
      i = i + 1: If i > UBound(TblE) Then Exit Do
     Loop
  Loop
  [A2].Resize(n, UBound(TblS, 2)) = TblS
End Sub

Bisson

Cliquez pour agrandir...