Injecter le contenu de cellules de 200 fichiers dans un seul

Bonjour tout le monde,

Alors voila la situation.

J'ai un gros fichier, avec une multitude d'onglets, et plein de petits fichiers mineurs. Les petits fichiers mineurs sont de deux types, soit complet, soit incomplet.

Mon gros fichier contient bcp d'onglets dont le nom correspond à la date du jour, au format suivant : jj-mm ; ces onglets se suivent chronologiquement. Parfois, certains onglets ne sont pas des dates. Ils ne rentrent pas alors ds la manipulation.

Je voudrais faire la manipulation suivante, ça passe par une macro j'imagine :

la macro injecte dans la cellule A2 de l'onglet 01-03 la somme de B3+E3 du fichier fichiercomplet_01-03.xls ; si fichiercomplet_01-03.xls n'existe pas, elle injecte depuis fichierincomplet_01-03.xls. Si aucun des deux n'existe, alors la macro n'injecte rien.

Tous mes fichiers sont ds le même répertoire.

Mes onglets date de mon gros tableau vont actuellement du 1er janv au 30 juin. Il y'a des sauts parfois entre deux dates.

Merci bcp d'avance

Laure

Bonjour,

Il faut ajouter un onglet Tempo dans ton gros classeur, et copier le code des 2 procédure dans un module standard de ce même classeur.

Le scénario du traitement est le suivant :

• Préparation onglet Tempo
• Strute tous les fichiers du dossier
• Note le nom du fichier
• Tri de la liste des fichiers
• parcours de la liste
• si fichier complet alors report et montée d'un témoin
• si fichier incomplet et pas témoin alors report

Sub traitement()
Dim Chemin As String, Fichier As String, Inter As String
Dim LigneMax As Long, Tourne As Long
Dim Trouvé As Boolean

'Préparation onglet Tempo
ThisWorkbook.Worksheets("Tempo").Range("a1:a65536").Delete

'Amorce de la recherche par dir
Chemin = ThisWorkbook.Path
Fichier = Dir(Chemin & "\*.xls")

' Strute tous les fichiers du dossier
Do
 'Prise encompte des fichiers si pas le gros fichier
 If Fichier <> ThisWorkbook.Name Then
 ' Note le nom du fichier
  LigneMax = ThisWorkbook.Worksheets("Tempo").Range("a" & Rows.Count).End(xlUp).Row + 1
  ThisWorkbook.Worksheets("Tempo").Range("a" & LigneMax) = Fichier
 End If
 'Fichier suivant
 Fichier = Dir
Loop Until Fichier = ""
' Recherche de la ligne du dernier fichier
LigneMax = ThisWorkbook.Worksheets("Tempo").Range("a" & Rows.Count).End(xlUp).Row
'Tri de la liste
Range("A2:a" & LigneMax).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Traitement des occurences
For Tourne = 2 To LigneMax
 Fichier = Chemin & "\" & ThisWorkbook.Worksheets("Tempo").Range("a" & Tourne)
 'Si fichiercomplet
 If InStr(1, Fichier, "fichiercomplet") > 0 Then
  reporte "fichiercomplet", Fichier
  'Monte le témoin trouvé
  trouve = True
 End If
 ' Si fichierincomplet et pas fichiercomplet
 If InStr(1, Fichier, "fichierincomplet") > 0 And Not trouve Then
  If Inter = Mid(Fichier, InStrRev(Fichier, "\") + 15, 5) Then
    'Appel procédure de report des informations
    reporte "fichierincomplet", Fichier
  End If
 End If
End If
trouve = False
Next Tourne
End Sub
Sub reporte(Typefiche As String, Fichier As String)
Dim Portion As String
 'Ouverture du classeur
 Workbooks.Open Filename:=Fichier
 Portion = Mid(Fichier, InStrRev(Fichier, "\") + 15, 5)
 'Lecture des valeurs, calcul et transfert
 ThisWorkbook.Worksheets(Portion).Range("A2") = Val(ActiveWorkbook.ActiveSheet.Range("B3")) + Val(ActiveWorkbook.ActiveSheet.Range("E3"))
 'Fermeture du classeur
 Workbooks("fichiercomplet" & Portion & ".xls").Close False
End Sub