Boucle pour consolidation de fichiers VBA
Résolu
lati75
-
lati75 Messages postés 4 Statut Membre -
lati75 Messages postés 4 Statut Membre -
Bonjour,
j'ai fais une macro pour consolider 4 onglets excel dans un classeur excel unique SYNTHESE. Le problème est que ma boucle semble se réaliser plusieurs fois car j'ai au final plus de 23000 lignes de données dans mon classeur final SYNTHESE, alors que la somme des lignes de mes 4 fichiers est de 6000 lignes environ.
J'aimerai savoir si ma boucle est bien placée dans mon code VBA? Merci
Voici le code que j'ai réalisé:
Sub Macro1()
'Déclaration des variables
Dim i As Integer
Dim j As Integer
Dim DerniereLigne As Integer
Dim DerniereLigneSynthese As Integer
Dim nbfichiers As Integer
Dim TotAixmarseille As Integer
Dim TotLyon As Integer
Dim TotNantes As Integer
Dim TotToulouse As Integer
Dim SommeFichiers As Integer
Dim SommeSynthese As Integer
'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro
Application.ScreenUpdating = False
EffaceDonnees
'Boucle permettant de lire toutes les feuilles à consolider
'Indique le nombre de fichiers à consolider
nbfichiers = 4
For j = 1 To nbfichiers
'Aix Marseille
'Sélectionne la feuille où se trouvent les données
Sheets("Aix Marseille_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotAixmarseille = DerniereLigne
'Lyon
'Sélectionne la feuille où se trouvent les données
Sheets("Lyon_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotLyon = DerniereLigne
'Nantes
'Sélectionne la feuille où se trouvent les données
Sheets("Nantes_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotNantes = DerniereLigne
'Toulouse
'Sélectionne la feuille où se trouvent les données
Sheets("Toulouse_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotToulouse = DerniereLigne
Next j
'calcul de la somme des lignes de toutes les feuilles des régions
SommeFichiers = TotAixmarseille + TotLyon + TotNantes + TotToulouse
MsgBox SommeFichiers
'calcul de la somme des lignes de la feuille SYNTHESE
SommeSynthese = DerniereLigneSynthese - 1
MsgBox SommeSynthese
'comparaison du nombre de lignes trouvées
If SommeFichiers = SommeSynthese Then
MsgBox "Le compte est bon"
Else: MsgBox "il n'y a pas le même nombre de lignes"
End If
'bouton execution macro
MsgBox "fichier SYNTHESE prêt", vbOKOnly + vbInformation, "Information"
Application.ScreenUpdating = True
End Sub
j'ai fais une macro pour consolider 4 onglets excel dans un classeur excel unique SYNTHESE. Le problème est que ma boucle semble se réaliser plusieurs fois car j'ai au final plus de 23000 lignes de données dans mon classeur final SYNTHESE, alors que la somme des lignes de mes 4 fichiers est de 6000 lignes environ.
J'aimerai savoir si ma boucle est bien placée dans mon code VBA? Merci
Voici le code que j'ai réalisé:
Sub Macro1()
'Déclaration des variables
Dim i As Integer
Dim j As Integer
Dim DerniereLigne As Integer
Dim DerniereLigneSynthese As Integer
Dim nbfichiers As Integer
Dim TotAixmarseille As Integer
Dim TotLyon As Integer
Dim TotNantes As Integer
Dim TotToulouse As Integer
Dim SommeFichiers As Integer
Dim SommeSynthese As Integer
'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro
Application.ScreenUpdating = False
EffaceDonnees
'Boucle permettant de lire toutes les feuilles à consolider
'Indique le nombre de fichiers à consolider
nbfichiers = 4
For j = 1 To nbfichiers
'Aix Marseille
'Sélectionne la feuille où se trouvent les données
Sheets("Aix Marseille_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotAixmarseille = DerniereLigne
'Lyon
'Sélectionne la feuille où se trouvent les données
Sheets("Lyon_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotLyon = DerniereLigne
'Nantes
'Sélectionne la feuille où se trouvent les données
Sheets("Nantes_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotNantes = DerniereLigne
'Toulouse
'Sélectionne la feuille où se trouvent les données
Sheets("Toulouse_final").Select
'récupère les lignes jusqu'à la dernière ligne non vide
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:BD" & DerniereLigne).Select
Selection.Copy
'aller sur la feuille SYNTHESE
Sheets("SYNTHESE").Select
'passe à la nouvelle ligne vide pour copier le reste des autres classeurs
DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(DerniereLigneSynthese, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
TotToulouse = DerniereLigne
Next j
'calcul de la somme des lignes de toutes les feuilles des régions
SommeFichiers = TotAixmarseille + TotLyon + TotNantes + TotToulouse
MsgBox SommeFichiers
'calcul de la somme des lignes de la feuille SYNTHESE
SommeSynthese = DerniereLigneSynthese - 1
MsgBox SommeSynthese
'comparaison du nombre de lignes trouvées
If SommeFichiers = SommeSynthese Then
MsgBox "Le compte est bon"
Else: MsgBox "il n'y a pas le même nombre de lignes"
End If
'bouton execution macro
MsgBox "fichier SYNTHESE prêt", vbOKOnly + vbInformation, "Information"
Application.ScreenUpdating = True
End Sub
Configuration: Windows / Chrome 75.0.3770.80
A voir également:
- Boucle pour consolidation de fichiers VBA
- Explorateur de fichiers - Guide
- Renommer des fichiers en masse - Guide
- Fichiers epub - Guide
- Gestionnaire de fichiers - Télécharger - Gestion de fichiers
- Wetransfer gratuit fichiers lourd - Guide
1 réponse
Bonjour
Voici une proposition de correction
La boucle faisait 4 fois le travail.
Ensuite des petites erreurs de calcul il faut enlever 1 à chaque total pour tenir compte de la ligne entête.
Enfin il faut recalculer le nombre de ligne de Synthèse après la dernière insertion
Voici une proposition de correction
Sub Macro1() 'Déclaration des variables Dim i As Integer Dim j As Integer Dim DerniereLigne As Integer Dim DerniereLigneSynthese As Integer Dim nbfichiers As Integer Dim TotAixmarseille As Integer Dim TotLyon As Integer Dim TotNantes As Integer Dim TotToulouse As Integer Dim SommeFichiers As Integer Dim SommeSynthese As Integer 'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro Application.ScreenUpdating = False EffaceDonnees 'Boucle permettant de lire toutes les feuilles à consolider 'Indique le nombre de fichiers à consolider 'nbfichiers = 4 'For j = 1 To nbfichiers 'Aix Marseille 'Sélectionne la feuille où se trouvent les données Sheets("Aix Marseille_final").Select 'récupère les lignes jusqu'à la dernière ligne non vide DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row Range("A2:BD" & DerniereLigne).Select Selection.Copy 'aller sur la feuille SYNTHESE Sheets("SYNTHESE").Select 'passe à la nouvelle ligne vide pour copier le reste des autres classeurs DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1 Cells(DerniereLigneSynthese, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False TotAixmarseille = DerniereLigne - 1 'Lyon 'Sélectionne la feuille où se trouvent les données Sheets("Lyon_final").Select 'récupère les lignes jusqu'à la dernière ligne non vide DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row Range("A2:BD" & DerniereLigne).Select Selection.Copy 'aller sur la feuille SYNTHESE Sheets("SYNTHESE").Select 'passe à la nouvelle ligne vide pour copier le reste des autres classeurs DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1 Cells(DerniereLigneSynthese, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False TotLyon = DerniereLigne - 1 'Nantes 'Sélectionne la feuille où se trouvent les données Sheets("Nantes_final").Select 'récupère les lignes jusqu'à la dernière ligne non vide DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row Range("A2:BD" & DerniereLigne).Select Selection.Copy 'aller sur la feuille SYNTHESE Sheets("SYNTHESE").Select 'passe à la nouvelle ligne vide pour copier le reste des autres classeurs DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1 Cells(DerniereLigneSynthese, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False TotNantes = DerniereLigne - 1 'Toulouse 'Sélectionne la feuille où se trouvent les données Sheets("Toulouse_final").Select 'récupère les lignes jusqu'à la dernière ligne non vide DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row Range("A2:BD" & DerniereLigne).Select Selection.Copy 'aller sur la feuille SYNTHESE Sheets("SYNTHESE").Select 'passe à la nouvelle ligne vide pour copier le reste des autres classeurs DerniereLigneSynthese = Range("A" & Rows.Count).End(xlUp).Row + 1 Cells(DerniereLigneSynthese, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False TotToulouse = DerniereLigne - 1 'Next j 'calcul de la somme des lignes de toutes les feuilles des régions SommeFichiers = TotAixmarseille + TotLyon + TotNantes + TotToulouse MsgBox SommeFichiers 'calcul de la somme des lignes de la feuille SYNTHESE SommeSynthese = Range("A" & Rows.Count).End(xlUp).Row - 1 MsgBox SommeSynthese 'comparaison du nombre de lignes trouvées If SommeFichiers = SommeSynthese Then MsgBox "Le compte est bon" Else: MsgBox "il n'y a pas le même nombre de lignes" End If 'bouton execution macro MsgBox "fichier SYNTHESE prêt", vbOKOnly + vbInformation, "Information" Application.ScreenUpdating = True End Sub
La boucle faisait 4 fois le travail.
Ensuite des petites erreurs de calcul il faut enlever 1 à chaque total pour tenir compte de la ligne entête.
Enfin il faut recalculer le nombre de ligne de Synthèse après la dernière insertion
lati75
Messages postés
4
Statut
Membre
Merci beaucoup pilas31!! la macro fonctionne et me renvoie bien le même nombre de lignes :-)