Consolidation de tableau - VBA

Bonjour,

J'ai créé 700 tableaux excel (dans 700 fichiers distincts stockés au même endroit) qui ont exactement la même structure. Je souhaite consolider ces 700 tableaux dans un tableau récapitutatif en faisant la somme des valeurs numériques. Je connais bien la fonction Consolidation mais s'il faut renseigner manuellement chaque tableau à consolider, çà risque d'être long et source d'erreurs !

J'ai donc essayé d'écrire une macro qui récupère chaque tableau un par un et ajoute la plage à consolider, cf ci-dessous.

Mais çà ne fonctionne pas, je ne parviens pas à renseigner correctement tous les éléments à consolider, en outre il faut que tous les fichiers soient ouverts au préalable, ce qui n'est pas très pratique..... Pouvez-vous m'aider ?

Merci beaucoup !

Sub Consolidation()

Dim fichier As String

chemin = ActiveWorkbook.Path

fichier = Dir(chemin & "\" & "*.xls")

Application.ScreenUpdating = True

Do While fichier <> ""

Range("B2:B11").Consolidate Sources:="[" & fichier & "]" & "!B2:B11", Function:=xlSum

fichier = Dir()

Loop

Application.ScreenUpdating = True

End Sub

Bonjour

Je ne connaissais pas cette fonction

Voilà ce que j'ai trouvé (Fonctionnel)

Sub Consolidation()
Dim Fichier As String, Chemin As String
Dim Indice As Integer
Dim Tablo() As String

  Chemin = ThisWorkbook.Path & "\"
  Fichier = Dir(Chemin & "*.xls")

  Application.ScreenUpdating = True
  ' Construction du tableau
  Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
      ReDim Preserve Tablo(Indice)
      Tablo(Indice) = "'[" & Fichier & "]'!R2C2:R11C2"
      Indice = Indice + 1
    End If
    Fichier = Dir()
  Loop
  ' Consolidation
  Range("B2:B11").Consolidate Sources:=Tablo, Function:=xlSum
End Sub

Merci pour cette réponse super rapide !!!!!

Par contre çà ne marche pas, j'ai un message indiquant "impossible d'ouvrir le fichier....", même en ouvrant au préalable tous les fichiers. Pourtant le chemin d'accès est bon et les fichiers à consolider sont bien dans le même répertoire que le fichier contenant la macro.

Merci encore pour votre aide !

Je viens de trouver la cause du message d'erreur, il fallait ajouter le chemin d'accès et CA MARCHE ! Merci !

Sub consolid1()

Dim Fichier As String, Chemin As String

Dim Indice As Integer

Dim Tablo() As String

Chemin = ThisWorkbook.Path & "\"

Fichier = Dir(Chemin & "*.xls")

Application.ScreenUpdating = True

' Construction du tableau

Do While Fichier <> ""

If Fichier <> ThisWorkbook.Name Then

ReDim Preserve Tablo(Indice)

Tablo(Indice) = "'" & Chemin & "[" & Fichier & "]'!R2C2:R11C2"

Indice = Indice + 1

End If

Fichier = Dir()

Loop

' Consolidation

Range("B2:B11").Consolidate Sources:=Tablo, Function:=xlSum

End Sub

Bonjour

Édit : Très bien tu avais trouvé

Modifies la macro (partie surlignée)

Sub Consolidation()
Dim Fichier As String, Chemin As String
Dim Indice As Integer
Dim Tablo() As String

  Chemin = ThisWorkbook.Path & "\"
  Fichier = Dir(Chemin & "*.xls")

  Application.ScreenUpdating = True
  ' Construction du tableau
  Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
      ReDim Preserve Tablo(Indice)
      Tablo(Indice) = "'" & Chemin & "[" & Fichier & "]Feuil1'!R2C2:R11C2"
      Indice = Indice + 1
    End If
    Fichier = Dir()
  Loop
  ' Consolidation
  Range("B2:B11").Consolidate Sources:=Tablo, Function:=xlSum
End Sub