Boucle pour consolidation de fichiers VBA
Résolu/Fermé
lati75
-
5 mars 2020 à 14:26
lati75 Messages postés 4 Date d'inscription jeudi 5 mars 2020 Statut Membre Dernière intervention 3 juin 2020 - 6 mars 2020 à 10:39
lati75 Messages postés 4 Date d'inscription jeudi 5 mars 2020 Statut Membre Dernière intervention 3 juin 2020 - 6 mars 2020 à 10:39
A voir également:
- Boucle pour consolidation de fichiers VBA
- Wetransfer gratuit fichiers lourd - Guide
- Explorateur de fichiers - Guide
- Renommer plusieurs fichiers - Guide
1 réponse
pilas31
Messages postés
1825
Date d'inscription
vendredi 5 septembre 2008
Statut
Contributeur
Dernière intervention
24 avril 2020
643
Modifié le 5 mars 2020 à 15:32
Modifié le 5 mars 2020 à 15:32
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
6 mars 2020 à 10:39