1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Fusionner les données des feuilles de plusieurs classeurs excel en un seul classeur

Fusionner les données des feuilles de plusieurs classeurs excel en un seul classeur

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 026 fois - Téléchargée 18 fois

Commenter

Contenu du snippet

Ce code regroupe les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur. Il permet de fusionner les données de plusieurs classeurs chacun ayant 3 feuilles en un seul classeur d'une seule feuille. les informations des classeurs différents seront mises les unes après les autres. une ligne noir permet de visualiser le changement de fichier
le compilateur va compiler de la manière suivante:
En colonne A à D les données des Feuilles n° 1
En colonne E à J les données des Feuilles n°2
En colonne K à M les données des feuilles n° 3

A la fin juste un petit message de confirmation indiquant le nombre de fichiers traités ainsi que la liste de ces derniers, cela pourra être utile pour contrôler.

j'espère que ca vous aide.....

Source / Exemple : 


Sub LaunchCompilation()
' Ce code doit servir à regrouper les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur

Application.DisplayAlerts = False ' pour éviter les message demandant confirmation lors d'une fermeture (notamment le fait d'avoir des données dans le presse papier
chemin = ThisWorkbook.Path 'chemin du dossier qui contient les autres fichiers et où est enregistré ce fichier qui servira de compilateur
Set fso = New FileSystemObject 'l'utilisation des FSO nécessite l'activation de la référence Microsoft Scripting Runtime
Set dossier = fso.GetFolder(chemin) '
Dim r As Integer ' r sera le n° de la ligne de la feuille compilateur
r = 1
Dim nbfichiers ' nbfichier sera le nombre de fichiers traités
nbfichier = 0
Dim listedesfichierstraités As String

For Each fichier In dossier.Files ' boucle sur les fichiers
    If fso.GetExtensionName(fichier.Path) = "xls" And fichier.Name <> ThisWorkbook.Name Then 'sélection des fichiers à traiter : classeurs excel et pas le compilateur
    nbfichiers = nbfichiers + 1
    listedesfichierstraités = listedesfichierstraités & fichier.ShortName & Chr(10)
    Workbooks.Open fichier 'ouverture d'un fichier
    
        For i = 1 To ActiveWorkbook.Sheets.Count ' boucle sur les feuilles de ce fichier
        Sheets(i).Select 'sélection de la feuille
        
        
        Select Case i
        Case 1
        lastrow1 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
        Range(Cells(1, 1), Cells(lastrow1, 4)).Copy 'copie des cellules de la plage A1:D dernière ligne
        ThisWorkbook.Activate 'on se place sur le fichier de compilation
        Sheets(1).Cells(r, 1).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne A
        ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
        Case 2
        lastrow2 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
        Range(Cells(1, 1), Cells(lastrow2, 6)).Copy 'copie des cellules de la plage A1:F dernière ligne
        ThisWorkbook.Activate 'on se place sur le fichier de compilation
        Sheets(1).Cells(r, 5).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne E
        ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
        Case 3
        lastrow3 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
        Range(Cells(1, 1), Cells(lastrow3, 3)).Copy 'copie des cellules de la plage A1:C dernière ligne
        ThisWorkbook.Activate 'on se place sur le fichier de compilation
        Sheets(1).Cells(r, 11).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne K
        ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
        End Select
        Cells(r, 1).EntireRow.Interior.ColorIndex = 1
        
                
        Workbooks(fichier.Name).Activate
        Next i
        
        If lastrow1 > lastrow2 And mastrow1 > lastrow3 Then
        lastrow = lastrow1
        Else
            If lastrow2 > lastrow1 And lastrow2 > lastrow3 Then
            lastrow = lastrow2
            Else
            lastrow = lastrow3
            End If
        End If
        
        r = r + lastrow 'on ajoute à r la dernière ligne pour toujours se placer sur la 1ère cellule vide de la colonne A
     
     
    Workbooks(fichier.Name).Close (False) 'on ferme le fichier ouvert précédemment
    End If
Next fichier
Application.DisplayAlerts = True 'on rétablie le paramétrage standard
Cells(1, 1).Select
MsgBox ("Le traitement est terminé." & Chr(10) & nbfichiers & " fichiers ont été traités, en voici la liste :" & Chr(10) & listedesfichierstraités)
End Sub

A voir également

Ajouter un commentaire

Commentaires

Signaler
Messages postés
7
Date d'inscription
dimanche 20 février 2005
Statut
Membre
Dernière intervention
7 avril 2010
Bonjour,

dans le même ordre d'idée tu devrais forcer la déclaration des variables (option explicit)ta variable lastrow1 est devenue mastrow1

Je ne comprends pas non plus l'utilité des faire 3 variables lastrow alors qu'elle calcul la même chose

bonne prog
deuxmains
Signaler
Messages postés
291
Date d'inscription
vendredi 21 février 2003
Statut
Membre
Dernière intervention
13 mars 2015
Bonjour
-------------------------------------
Il est délicat de travailler sur les objets courants.
Il suffit que l'utilisateur est la gâchette facile sur la souris, et le classeur que l'on croyait actif n'est plus le même et tout part en vrille.
Ceci est particulièrement vrai sur les traitement un peu long.

Plutôt que d'utiliser ActiveSheet ou cells directement,
Iil vaudrait mieux travailler sur des instances d'objet:
exemple:

dim wb as workbook
set wb = Workbooks.Open fichier 'ouverture d'un fichier
'et ensuite utiliser wb pour travailler sur ce classeur
'par exemple pour mettre une valeur dans une feuille:
wb.worksheets("nomDeLaFeuille").cells(1,1)= laValeur
ou
dim ws as worksheet
set ws=wb.worksheets("nomDeLaFeuille")
ws.cells(1,1)= laValeur

Attention si depuis Excel 2000 il y a bien 65536 lignes dans un classeurs, dans les versions antérieure il n'y en a que la moitié (Beaucoup d'applis Excel tournent encore sur des versions 97).

Toute les feuilles du classeur source sont traitées, quid des feuilles masquées par exemple ?
de plus c'est la collection Sheets qui est parcourue, mais dans sheets il peut y avoir d'autre type de feuilles: graphique, ancienne macro excel 4 (he oui y en a encore!!!) ...
Il est préférable de parcourir la collection worksheets, ou alors il faut tester le type de la feuille.

J'espère que ces remarques t'aideront à fiabiliser ce code.
JJDAI
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.