Macro pour extraire des chiffres de différents classeurs en les ajoutant

Lettou

XLDnaute Nouveau
Bonjour à tous!

Je suis entrain de créer une macro qui me permettrait de récolter des informations chiffrées dans plusieurs classeurs qui seront mis à jour chaque mois.

Il y aura au moins 30 classeurs par mois, mais il se peut que certains mois il y ai peut-être un classeur de plus ou de moins ou une ligne de plus ou de moins dans les classeurs, cela dépend de la personne qui le remplira.

Je voudrais donc créer une macro qui va chercher les informations dans chaque classeur et les rapporte dans le classeur RECAP.

J'ai commencé par créer un dossier dans "mes documents" ou je vais mettre tous les classeurs reçu chaque mois.
Comme ca je collerai chaque mois ces classeurs dans le fichier et la macro ira les chercher.

Jusque là tout va bien, la macro fonctionne: elle va chercher le classeur dans mes documents, l'ouvre, copie les chiffres, et colle ces chiffres dans le classeur RECAP puis passe à l'autre classeur, copie, colle.etc...

Mon problème : quand je lance ma macro, a chaque fois qu’elle ouvre un nouveau classeur et qu'elle copie les chiffres dans le classeur RECAP, elle efface les anciens chiffres copiés du classeur précédent, il n’y a donc aucun cumule…
J'aimerais donc pouvoir ajouter un code pour ajouter chaque chiffres au précédent, comme un genre de « collage spécial addition ». Et c’est à ce moment là que je bloque !!!

De plus, J’ai réussi à faire cette macro pour les 4 onglets du classeur RECAP mais ça fait long, je ne sais pas si c’est possible de simplifier les codes.

Je fais donc appel à vous pour pouvoir progresser. Pourriez-vous m'aider à compléter ma macro?

A noter:

Voici les fichiers pour vous aider à comprendre mon problème, Les cellules à copier sont celles qui font partie du cadre bleu. Chaque classeur que je recevrai aura un nom de pays, j’ai pris comme exemple France, Italie, Espagne dans ma macro.




Merci !

Lettou
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

Re,

plein de lignes vides dans ton classeur "FRANCE".... si il faut les copier coller également quels critères pour déterminer le nombre de lignes ? la colonne A ou B ? ces 2 colonnes sont d'ailleurs déjà renseignées dans le classeur "recap"...
 
Dernière édition:

Lettou

XLDnaute Nouveau
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

En fait la colonne A et la B je ne veux pas les copier, car elles ne changeront jamais. Pour déterminer le nombre de ligne il faudrait plutôt se v-baser sur la colonne A, car la b ne sert à rien, c'est juste une mise en forme.

je veux juste copier tout ce qui est en bleu, même celles qui sont vides vu que suivant le mois elles seront toutes remplies au fur et à mesure... En fait j'aimerais que le fichier RECAP copie exactement les informations telles qu'elles sont dans les classeurs en additionnant juste chaque chiffres recueillis par chaque classeur. Il faut aussi prendre en compte que j'aurais plus de "À classeurs qui seront dans "mes documents" et que cela variera suivant les mois

J'ai modifié les fichiers pour plus de compréhension,


Merci de ton aide
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

Re,

un exemple de boucle sur les feuilles du fichier "FRANCE" à utiliser dans un module standard :
Code:
Option Explicit
Sub test()
Dim p As Range, wb As Workbook, ws As Worksheet
Set p = Workbooks("RECAP.xlsm").Sheets("RECAP").Range("C7:CV192")
Set wb = Workbooks.Open("D:\My Documents\FRANCE.xlsm")
For Each ws In wb.Worksheets
    ws.Range("C7:CV192").Copy
    p.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Next ws
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

Re,

une boucle sur tous les fichiers xlsm du répertoire où se trouve le classeur avec le code, je te laisse adapter :
Code:
Option Explicit
Sub test()
Dim r As String, f As String, p As Range, wb As Workbook, ws As Worksheet
Set p = ThisWorkbook.Sheets(1).Range("C7:CV192")
r = ThisWorkbook.Path & "\"
f = Dir(r & "*.xlsm")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(r & f)
        For Each ws In wb.Worksheets
            ws.Range("C7:CV192").Copy
            p.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
        Next ws
        wb.Close False
    End If
    f = Dir
Loop
End Sub
 

eriiic

XLDnaute Barbatruc
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

Bonjour à tous,

une autre proposition qui traite tous les fichiers du répertoire de RECAP.xlsx, à mettre uniquement dans RECAP.
A tester :
Code:
Sub Ouverturefer()
    Dim chemin As String, Fichier As String
    Dim wb As Workbook, shRecap As Worksheet, sh As Worksheet
    Dim nbLig As Long, nbCol As Long
    Set wb = ThisWorkbook
    Set shRecap = Worksheets("RECAP")
    chemin = wb.Path + "\"
    nbLig = Cells(Rows.Count, "A").End(xlUp).Row - 6
    nbCol = Cells(5, Columns.Count).End(xlToLeft).Column - 2
    Fichier = Dir(chemin & "*.xl*")    ' 1er fichier
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Do While (Len(Fichier) > 0)
        If Fichier <> ThisWorkbook.Name Then
            Workbooks.Open chemin & Fichier
            ' traitement
            For Each sh In Worksheets
                sh.[C7].Resize(nbLig, nbCol).Copy
                shRecap.[C7].PasteSpecial Operation:=xlAdd
            Next sh
            '
            ActiveWorkbook.Close
        End If
        Fichier = Dir()    ' fichier suivant
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Personnellement j'inscrirai dans une cellule 'Recap ok' pour éviter les accidents et ne pas traiter 2 fois un fichier. Ca obligerait à enregistrer le fichier et ralentirait. Tu dis...

eric

edit : ben finalement pierrot à complété son code plus vite que moi... :)
 

Pièces jointes

  • RECAP.xlsm
    113.6 KB · Affichages: 31
  • RECAP.xlsm
    113.6 KB · Affichages: 35
  • RECAP.xlsm
    113.6 KB · Affichages: 34
Dernière édition:

Lettou

XLDnaute Nouveau
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

Re,

une boucle sur tous les fichiers xlsm du répertoire où se trouve le classeur avec le code, je te laisse adapter :
Code:
Option Explicit
Sub test()
Dim r As String, f As String, p As Range, wb As Workbook, ws As Worksheet
Set p = ThisWorkbook.Sheets(1).Range("C7:CV192")
r = ThisWorkbook.Path & "\"
f = Dir(r & "*.xlsm")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(r & f)
        For Each ws In wb.Worksheets
            ws.Range("C7:CV192").Copy
            p.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
        Next ws
        wb.Close False
    End If
    f = Dir
Loop
End Sub


J'ai un souci la macro ne fonctionne pas, je crois que je ne remplace pas tout comme il le faut:

j'ai remplacé:

Set p = ThisWorkbook.Sheets(ITALIE).Range("C7:CV192")

r = ThisWorkbook.Path & "D:\documents and Settings\My Documents\PAYS"
f = Dir(r & RECAP")

Est-ce juste? Manque t il quelque chose?

Je suis novice dans les macro donc je ne connais pas tous les termes encore, difficile de tout comprendre,


Merci!
 

Lettou

XLDnaute Nouveau
Re : Macro pour extraire des chiffres de différents classeurs en les ajoutant

Bonjour à tous,

une autre proposition qui traite tous les fichiers du répertoire de RECAP.xlsx, à mettre uniquement dans RECAP.
A tester :
Code:
Sub Ouverturefer()
    Dim chemin As String, Fichier As String
    Dim wb As Workbook, shRecap As Worksheet, sh As Worksheet
    Dim nbLig As Long, nbCol As Long
    Set wb = ThisWorkbook
    Set shRecap = Worksheets("RECAP")
    chemin = wb.Path + "\"
    nbLig = Cells(Rows.Count, "A").End(xlUp).Row - 6
    nbCol = Cells(5, Columns.Count).End(xlToLeft).Column - 2
    Fichier = Dir(chemin & "*.xl*")    ' 1er fichier
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Do While (Len(Fichier) > 0)
        If Fichier <> ThisWorkbook.Name Then
            Workbooks.Open chemin & Fichier
            ' traitement
            For Each sh In Worksheets
                sh.[C7].Resize(nbLig, nbCol).Copy
                shRecap.[C7].PasteSpecial Operation:=xlAdd
            Next sh
            '
            ActiveWorkbook.Close
        End If
        Fichier = Dir()    ' fichier suivant
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Personnellement j'inscrirai dans une cellule 'Recap ok' pour éviter les accidents et ne pas traiter 2 fois un fichier. Ca obligerait à enregistrer le fichier et ralentirait. Tu dis...

eric

edit : ben finalement pierrot à complété son code plus vite que moi... :)



Bonjour Eric,

Ta macro à l'air intéressante, par conte j'ai un problème, quand je la lance ça me met erreur "impossible d'executer le code en mode arret" ça veut dire quoi?

Merci!
 

Discussions similaires

Statistiques des forums

Discussions
312 178
Messages
2 085 984
Membres
103 079
dernier inscrit
sle