Code VBA - Consolider
Résolu/Fermé
xavier62000
Messages postés
65
Date d'inscription
lundi 25 juin 2018
Statut
Membre
Dernière intervention
16 mars 2024
-
28 juin 2018 à 22:05
xavier62000 Messages postés 65 Date d'inscription lundi 25 juin 2018 Statut Membre Dernière intervention 16 mars 2024 - 30 juin 2018 à 00:22
xavier62000 Messages postés 65 Date d'inscription lundi 25 juin 2018 Statut Membre Dernière intervention 16 mars 2024 - 30 juin 2018 à 00:22
A voir également:
- Code VBA - Consolider
- Code asci - Guide
- Code puk bloqué - Guide
- Code telephone oublié - Guide
- Code activation windows 10 - Guide
- Consolider plusieurs feuilles excel - Guide
8 réponses
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 778
Modifié le 29 juin 2018 à 00:54
Modifié le 29 juin 2018 à 00:54
Bonjour,
J'aurais fait comme ça (en mettant tous les fichiers dans le même répertoire, y compris la macro de consolidation) :
Ton fichier en retour :
https://mon-partage.fr/f/p6djCCY9/
J'aurais fait comme ça (en mettant tous les fichiers dans le même répertoire, y compris la macro de consolidation) :
Option Explicit Sub consolider() ' Procédure permettant la consolidation de plusieurs classeurs ' Dim wbk As Workbook Dim wshScr As Worksheet Dim wshDst As Worksheet Dim celDst As Range Dim chemin As String Dim nomClasseur As String Dim derLigne As Long ' On désactive le raffraichissement de l'écran Application.ScreenUpdating = False ' Définition de la feuille de destination Set wshDst = ThisWorkbook.Worksheets("JOUEURS") ' Etape n°1 : création des en-têtes 'Réinitialisation du fichier de synthèse des classements With wshDst .Columns("B:AK").Clear .Range("B2").Value = "Equipe N°" .Range("C2").Value = "Joueurs N°" .Range("D2").Value = "Equipe" .Range("E2").Value = "Licence" .Range("F2").Value = "Nom Prénom" .Range("G2").Value = "Nom" .Range("H2").Value = "Prénom" .Range("I2").Value = "Points aller" .Range("J2").Value = "Points Gagnés" .Range("K2").Value = "Points Perdus" .Range("L2").Value = "Total des Points" .Range("M2").Value = "Evolution Clt" .Range("O2").Value = "Points Retour" .Range("P2").Value = "Points Gagnés 2" .Range("Q2").Value = "Points Perdus 3" .Range("R2").Value = " Total des Points 4" .Range("S2").Value = " Evolution Clt 5" .Range("T2").Value = "1" .Range("U2").Value = "2" .Range("V2").Value = "3" .Range("W2").Value = "4" .Range("X2").Value = "5" .Range("Y2").Value = "6" .Range("Z2").Value = "7" .Range("AA2").Value = "8" .Range("AB2").Value = "9" .Range("AC2").Value = "10" .Range("AD2").Value = "11" .Range("AE2").Value = "12" .Range("AF2").Value = "13" .Range("AG2").Value = "14" .Range("AH2").Value = "15" .Range("AI2").Value = "16" .Range("AJ2").Value = "17" .Range("AK2").Value = "18" ' On définit la cellule de destination des données Set celDst = .Range("B3") End With ' Etape n° 2 : Parcourir tous les fichiers du dossier prédéfini chemin = ThisWorkbook.Path & "\" ' On cherche le premier classeur dans le dossier nomClasseur = Dir(chemin & "*.xlsx") ' On boucle pour chercher tous les classeurs Do While Len(nomClasseur) > 0 If nomClasseur <> ThisWorkbook.Name Then Set wbk = Workbooks.Open(chemin & nomClasseur) 'Ouverture du Classeur On Error Resume Next Set wshScr = wbk.Worksheets("JOUEURS") 'Définis la feuille de calcul JOUEURS On Error GoTo 0 If Not wshScr Is Nothing Then With wshScr derLigne = .Cells(.Rows.Count, "B").End(xlUp).Row 'Numéro de le derniere ligne de données Range("B3:AK" & derLigne).Copy celDst 'Copie de toutes les données End With ' On définit la prochaine cellule de destination des données Set celDst = celDst.Offset(derLigne - 2) End If wbk.Close False ' Fermeture du classeur ouvert sans le modifier nomClasseur = Dir ' On passe au prochain classeur End If Loop MsgBox " Importation terminée " ' On ré-active le raffraichissement de l'écran ' Application.ScreenUpdating = True End Sub
Ton fichier en retour :
https://mon-partage.fr/f/p6djCCY9/
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 778
29 juin 2018 à 14:33
29 juin 2018 à 14:33
Re,
Désolé, une erreur de débutant passée inaperçue car tes fichiers d'essai n'avaient qu'une seule feuille :
J'ai oublié le point devant Range de la ligne 74, c'est donc les données de la feuille active qui étaient copiées au lieu de celles de wshSrc.
Voici ton fichier en retour, avec la suppression des lignes inutiles :
https://mon-partage.fr/f/SpLzVyzF/
Pour ce qui est du total des points, il faudrait le faire sur une autre feuille en ne conservant que les colonnes utiles.
Désolé, une erreur de débutant passée inaperçue car tes fichiers d'essai n'avaient qu'une seule feuille :
J'ai oublié le point devant Range de la ligne 74, c'est donc les données de la feuille active qui étaient copiées au lieu de celles de wshSrc.
Voici ton fichier en retour, avec la suppression des lignes inutiles :
https://mon-partage.fr/f/SpLzVyzF/
Pour ce qui est du total des points, il faudrait le faire sur une autre feuille en ne conservant que les colonnes utiles.
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 778
Modifié le 29 juin 2018 à 19:03
Modifié le 29 juin 2018 à 19:03
Désolé, encore une erreur de code, au lieu de :
Ecrire :
' Nom du prochain classeur nomClasseur = Dir End If Loop
Ecrire :
End If ' Nom du prochain classeur nomClasseur = Dir Loop
xavier62000
Messages postés
65
Date d'inscription
lundi 25 juin 2018
Statut
Membre
Dernière intervention
16 mars 2024
2
29 juin 2018 à 10:04
29 juin 2018 à 10:04
Bonjour Patrice,
Merci, pour tes explications, sur le sujet.
Mon fichier en retour est absent.
De plus, il faut savoir que ces fichiers sont partagés avec d'autres utilisateurs dans DROPBOX.
L'inconvénient, dans dropbox c'est que je peux partagés uniquement les dossiers "pour modifications" et par conséquent tous ces fichiers seront dans des répertoires différents. (A ce jour je n'ai pas encore fait les tests.
Peux tu me renvoyé mon fichier.
Bien à Toi
Xavier
Merci, pour tes explications, sur le sujet.
Mon fichier en retour est absent.
De plus, il faut savoir que ces fichiers sont partagés avec d'autres utilisateurs dans DROPBOX.
L'inconvénient, dans dropbox c'est que je peux partagés uniquement les dossiers "pour modifications" et par conséquent tous ces fichiers seront dans des répertoires différents. (A ce jour je n'ai pas encore fait les tests.
Peux tu me renvoyé mon fichier.
Bien à Toi
Xavier
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
xavier62000
Messages postés
65
Date d'inscription
lundi 25 juin 2018
Statut
Membre
Dernière intervention
16 mars 2024
2
29 juin 2018 à 11:01
29 juin 2018 à 11:01
Re, Patrice
J'ai bien le fichier en retour désolé. Mais celui-ci rencontre des soucis car il ne consolide pas les bonnes feuilles de calcul "JOUEURS". Si tu peux rejeter un oeil, je t'en serai reconnaissant
lien de téléchargement du fichier qui consolide : https://mon-partage.fr/f/FdvnCp6I/
Lien de téléchargement des 2 fichiers à consolider : https://mon-partage.fr/f/gd1Q5LH8/
https://mon-partage.fr/f/yfhfpCz1/
De plus, est il possible dans le fichier "Consolidation des classements" de :
1°) Supprimer les lignes qui se servent à rien (c'est à dire ou il n'y a pas de nom)
2°) D'additionner les points des joeurs dont le numéro de licence est identique (je dois certainement demander la lune mais il y a vraiment des cracs) à défaut, je ferai une autre feuille de calcul.
J'ai bien le fichier en retour désolé. Mais celui-ci rencontre des soucis car il ne consolide pas les bonnes feuilles de calcul "JOUEURS". Si tu peux rejeter un oeil, je t'en serai reconnaissant
lien de téléchargement du fichier qui consolide : https://mon-partage.fr/f/FdvnCp6I/
Lien de téléchargement des 2 fichiers à consolider : https://mon-partage.fr/f/gd1Q5LH8/
https://mon-partage.fr/f/yfhfpCz1/
De plus, est il possible dans le fichier "Consolidation des classements" de :
1°) Supprimer les lignes qui se servent à rien (c'est à dire ou il n'y a pas de nom)
2°) D'additionner les points des joeurs dont le numéro de licence est identique (je dois certainement demander la lune mais il y a vraiment des cracs) à défaut, je ferai une autre feuille de calcul.
xavier62000
Messages postés
65
Date d'inscription
lundi 25 juin 2018
Statut
Membre
Dernière intervention
16 mars 2024
2
29 juin 2018 à 18:19
29 juin 2018 à 18:19
Tout d'abord en grand merci,
Pour un débutant qu'est ce que je devrais dire moi : embrillons !!
La personne qui s'occupe des classements au niveau de ma région va etre heureux car avant avec sa feuille calcul je n'ose même pas t expliquer le report d'informations manuelles.
Au vu du fichier en retour, j'ai du modifier qq chose dans le code puisque maintenant l'extension des fichiers à consolider est en xlsm. Comme j'ai des macros avec les modifications apporter par Vaucluse.
Sauf que maintenant ça Bugg bien.
As tu encore un peu temps à m'accorder ?
Liens de téléchargement
https://mon-partage.fr/f/dKAz70kZ/
https://mon-partage.fr/f/GTQuRMdH/
https://mon-partage.fr/f/zhzaELox/
Merci pour ta patience
Pour un débutant qu'est ce que je devrais dire moi : embrillons !!
La personne qui s'occupe des classements au niveau de ma région va etre heureux car avant avec sa feuille calcul je n'ose même pas t expliquer le report d'informations manuelles.
Au vu du fichier en retour, j'ai du modifier qq chose dans le code puisque maintenant l'extension des fichiers à consolider est en xlsm. Comme j'ai des macros avec les modifications apporter par Vaucluse.
Sauf que maintenant ça Bugg bien.
As tu encore un peu temps à m'accorder ?
Liens de téléchargement
https://mon-partage.fr/f/dKAz70kZ/
https://mon-partage.fr/f/GTQuRMdH/
https://mon-partage.fr/f/zhzaELox/
Merci pour ta patience
xavier62000
Messages postés
65
Date d'inscription
lundi 25 juin 2018
Statut
Membre
Dernière intervention
16 mars 2024
2
29 juin 2018 à 19:54
29 juin 2018 à 19:54
Bonsoir Patrice
C'est NIckel, super sympa
Je vais voir pour la suite
xavier
C'est NIckel, super sympa
Je vais voir pour la suite
xavier
xavier62000
Messages postés
65
Date d'inscription
lundi 25 juin 2018
Statut
Membre
Dernière intervention
16 mars 2024
2
30 juin 2018 à 00:22
30 juin 2018 à 00:22
Bonsoir Patrice,
Peux tu me savoir quelle fonction que je peux prendre pour arriver à ce résultat
https://mon-partage.fr/f/DAzgJehU/
Merci d'avance
Peux tu me savoir quelle fonction que je peux prendre pour arriver à ce résultat
https://mon-partage.fr/f/DAzgJehU/
Merci d'avance