[XL-2007] Somme de colonnes de fichiers différents [Résolu]

[torvald]

Bonjour à tous,

J'ai plusieurs fichiers excel ayant la même structure càd colonne A on a des nombres colonnes B des heures, C nombres, D heures ainsi de suite et je voudrais une macro qui me fasse la somme de toutes les colonnes A mais cellule par cellule donc si on nomme f1 et f2 deux fichiers on aura dans le fichier résultat en A1=f1.A1 + f2.A1
A2=f1.A2 + f2.A2
Et ainsi de suite pour les autres colonnes

[bbil]

bonsoir ,

et une simple formule ne suffit pas ?

[torvald]

je ne crois pas comment faire le lien entre le fichier final et les différents fichiers (plus de 30) en sachant que les noms des fichiers sont crées de manière aléatoire

[ZebreLoup]

Quand tu dis que les noms des fichiers sont créés de manière aléatoire, c'est toi qui les créé ? Ils sont dans un répertoire ? Tu maîtrises leur nombre ? ...
Je crois qu'il nous faut un peu plus de détails pour t'aider, car effectivement, à la lecture de ton premier message, la réponse de bbil parait la plus logique.

[torvald]

Bonjour,

Oui les fichiers sont dans un répertoire ils sont au plus 30 et en ce qui concerne leur noms c'est le même avec la date du jour,càd un fichier par jour et en fin de mois je dois faire le fichier général

[ZebreLoup]

Et juste une dernière question avant une vraie réponse :
Tu maitrises le nombre de lignes dans chaque fichier ? Il y en a beaucoup ? C'est le même dans chaque fichier ?
Parce que je vois une solution simple mais qui peut être assez lente, et un truc plus rapide, mais qui est plus compliqué à gérer en fonction du nombre de lignes.

(Il y a aussi la possibilité de faire un copier-collage spécial addition avec chaque classeur, mais j'aime moins)

[torvald]

Salut zebreloup,

oui c'est le même nombre de lignes dans tous les fichiers il y en a 50.

[ZebreLoup]

Je te propose le code suivant. Finalement je fais un collage spécial-addition. Si tu veux faire autrement, tu peux modifier la procédure CopierUnFichier soit en ne copiant qu'un Range, soit en faisant une boucle sur des cellules.

Ce code doit être mis dans le classeur final pour le moment et copiera sur la feuille 1 les résultats.

N'oublie pas de modifier le chemin et la racine des fichiers source.

Code :

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
Option Explicit
 
Private Const CHEMIN_FICHIERS = "D:\DONNEES\Temp\testDVP.COM\Sources" 'Mettre ici le chemin du répertoire
    'contenant les fichiers sources.
Private Const RACINE_FICHIER = "source" 'La racine du nom des fichiers
 
Public Sub AggregationFichier()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim wsFinal As Worksheet
    Set wsFinal = ThisWorkbook.Worksheets(1)
 
    Dim fso As New Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fl As Scripting.File
 
    On Error Resume Next
    Set fld = fso.GetFolder(CHEMIN_FICHIERS)
    If Err.Number <> 0 Then
        MsgBox "Le dossier '" & CHEMIN_FICHIERS & "' n'a pas été trouvé"
        Exit Sub
    End If
    On Error GoTo 0
 
    For Each fl In fld.Files
        If Len(fl.Name) >= Len(RACINE_FICHIER) Then
        If Left(fl.Name, Len(RACINE_FICHIER)) = RACINE_FICHIER Then
            CopierUnFichier fl.Path, wsFinal
        End If
        End If
    Next fl
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Private Sub CopierUnFichier(ByVal fileName As String, ByRef wsFinal As Worksheet)
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
 
    On Error Resume Next
    Set wbSource = Workbooks.Open(fileName)
    If Err.Number <> 0 Then
        MsgBox "Le fichier '" & fileName & "' n'a pas pu être ouvert"
        Exit Sub
    End If
    On Error GoTo 0
 
    Set wsSource = wbSource.Worksheets(1)
 
    wsSource.Cells.Copy
    wsFinal.Cells.PasteSpecial Paste:=xlPasteValues, operation:=xlPasteSpecialOperationAdd
 
    wbSource.Close savechanges:=False
End Sub

[torvald]

Salut ZebreLoup,

Tout simplement nickel ça marche à merveille, merci de m'avoir épargné des heures de copie coller !!!!