Synthese
Fermé
Pio
-
26 avril 2020 à 16:00
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 - 26 avril 2020 à 20:45
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 - 26 avril 2020 à 20:45
A voir également:
- Synthese
- Tableau de synthèse excel - Guide
- Logiciel de synthèse vocale gratuit - Télécharger - Synthèse vocale
- Chatgpt synthese vocale - Guide
- Logiciel image de synthèse ✓ - Forum Logiciels
- Synthèse word - Forum Word
2 réponses
yg_be
Messages postés
22720
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 avril 2024
1 476
26 avril 2020 à 16:20
26 avril 2020 à 16:20
bonjour,
qu'as-tu essayé, quel obstacle as-tu rencontré?
qu'as-tu essayé, quel obstacle as-tu rencontré?
Hello
Voici le CODE:
--> Je ne sais comment coller dans le ficheir des synthèses les cellules que j'ai besoin.
Option Explicit
'Declaration de variable
Dim NomClasseur As String
Dim DerLigne As Integer
Dim DerLigneTable As Integer
'Procédure permettant la consolidation de pluseiurs classeurs
Sub Consolider()
'Etape nº1 : Création des en-têtes
'On reinitialise le fichier synthèse à chaque démarrage
Columns("A:AA").Clear
Range("A10").Value = "PRG"
Range("B10").Value = "SERVICE"
Range("C10").Value = "NºFEP"
Range("D10").Value = "DATE"
Range("E10").Value = "RESPONSABLE"
Range("F10").Value = "MP"
Range("G10").Value = "DESIGNATION"
Range("H10").Value = "REFERENCE"
Range("I10").Value = "INTITULE"
Range("J10").Value = "BEP"
Range("K10").Value = "BEM"
Range("L10").Value = "MTC"
Range("M10").Value = "QP"
Range("N10").Value = "QDP"
Range("O10").Value = "MDC"
Range("P10").Value = "LOP"
Range("Q10").Value = "HA"
Range("R10").Value = "PU"
Range("S10").Value = "INDUS"
Range("T10").Value = "MANUF"
Range("U10").Value = "DOM"
Range("V10").Value = "DATE DE CREATION"
Range("W10").Value = "RESP BE"
Range("X10").Value = "RESP CPPP"
Range("Y10").Value = "DELAI DE REPONSE"
Range("Z10").Value = "ACCORD LANCEMENT"
Range("A10:I10").Interior.Color = RGB(255, 204, 153) 'Couleur de remplissage
Range("J10:U10").Interior.Color = RGB(0, 0, 0) 'Couleur de remplissage
Range("V10:Z10").Interior.Color = RGB(255, 204, 153) 'Couleur de remplissage
Range("A10:I10").Font.Color = vbBlack 'Couleur de police
Range("J10:U10").Font.Color = vbWhite 'Couleur de police
Range("V10:Z10").Font.Color = vbBlack 'Couleur de police
'Etape nº 2: Parcourir tous les fichiers du dossier prédéfini
ChDir "C:\Users\pio.rodriguez\Desktop\FEP"
'on cherche le premier classeur dans un dossier
NomClasseur = Dir("C:\Users\pio.rodriguez\Desktop\FEP\*.xlsm")
'on boucle pour chercher tous les classeurs
While Len(NomClasseur) > 0
Application.DisplayAlerts = False 'Desactive les boites de dialogue Excel
Application.ScreenUpdating = False
Workbooks.Open NomClasseur 'Ouverture du classeur
Range("K11").Copy
Range("B11") 'Code Projet
Range("K9").Copy 'Service
Range("AI9").Copy 'Nº FEPP
Range("Q9").Copy 'DATE
Range("C9").Copy 'Responsable
Range("C11").Copy 'MP
Range("F10").Copy 'DESIGNATION
Range("AG13").Copy 'REFERENCE
Range("T16").Copy 'INTITULE
Range("BH12").Copy 'BEP
Range("BH17").Copy 'BEM
Range("BH24").Copy 'MTC
Range("BH29").Copy 'QP
Range("BD35").Copy 'QDP
Range("BV35").Copy 'MDC
Range("BH40").Copy 'LOP
Range("BH49").Copy 'HA
Range("BT49").Copy 'Pilote Usine
Range("AY58").Copy 'Industrialisation
Range("BV58").Copy 'Manufacturing
Range("BN64").Copy 'DOM
Range("D68").Copy 'DATE DE CREATION
Range("M68").Copy 'Responsable BE
Range("AI68").Copy 'CPP
Range("AC9").Copy 'Delai de réponse
Range("BN64").Copy 'date LANCEMENT
Range("AX61").Copy 'ACCORD LANCEMENT
Workbooks("EVOLUTION FEP.xlsm").Activate 'on revient sur le classeur
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 'on recherche la dernière ligne vide de la feuille
Range("A10" & DerLigne).Select 'On se positionne sur la dernière ligne de la feuille
ActiveSheet.Paste 'Je colle les données
Workbooks(NomClasseur).Close 'Fermeture du classeur ouvert
NomClasseur = Dir 'On passe au prochain classeur
Wend
' DerLigneTable = ActiveSheet.UsedRange.Rows.Count + 1
Cells.EntireColumn.AutoFit 'On auto-ajuste les colonnes
Range("A1").Select
End Sub
Voici le CODE:
--> Je ne sais comment coller dans le ficheir des synthèses les cellules que j'ai besoin.
Option Explicit
'Declaration de variable
Dim NomClasseur As String
Dim DerLigne As Integer
Dim DerLigneTable As Integer
'Procédure permettant la consolidation de pluseiurs classeurs
Sub Consolider()
'Etape nº1 : Création des en-têtes
'On reinitialise le fichier synthèse à chaque démarrage
Columns("A:AA").Clear
Range("A10").Value = "PRG"
Range("B10").Value = "SERVICE"
Range("C10").Value = "NºFEP"
Range("D10").Value = "DATE"
Range("E10").Value = "RESPONSABLE"
Range("F10").Value = "MP"
Range("G10").Value = "DESIGNATION"
Range("H10").Value = "REFERENCE"
Range("I10").Value = "INTITULE"
Range("J10").Value = "BEP"
Range("K10").Value = "BEM"
Range("L10").Value = "MTC"
Range("M10").Value = "QP"
Range("N10").Value = "QDP"
Range("O10").Value = "MDC"
Range("P10").Value = "LOP"
Range("Q10").Value = "HA"
Range("R10").Value = "PU"
Range("S10").Value = "INDUS"
Range("T10").Value = "MANUF"
Range("U10").Value = "DOM"
Range("V10").Value = "DATE DE CREATION"
Range("W10").Value = "RESP BE"
Range("X10").Value = "RESP CPPP"
Range("Y10").Value = "DELAI DE REPONSE"
Range("Z10").Value = "ACCORD LANCEMENT"
Range("A10:I10").Interior.Color = RGB(255, 204, 153) 'Couleur de remplissage
Range("J10:U10").Interior.Color = RGB(0, 0, 0) 'Couleur de remplissage
Range("V10:Z10").Interior.Color = RGB(255, 204, 153) 'Couleur de remplissage
Range("A10:I10").Font.Color = vbBlack 'Couleur de police
Range("J10:U10").Font.Color = vbWhite 'Couleur de police
Range("V10:Z10").Font.Color = vbBlack 'Couleur de police
'Etape nº 2: Parcourir tous les fichiers du dossier prédéfini
ChDir "C:\Users\pio.rodriguez\Desktop\FEP"
'on cherche le premier classeur dans un dossier
NomClasseur = Dir("C:\Users\pio.rodriguez\Desktop\FEP\*.xlsm")
'on boucle pour chercher tous les classeurs
While Len(NomClasseur) > 0
Application.DisplayAlerts = False 'Desactive les boites de dialogue Excel
Application.ScreenUpdating = False
Workbooks.Open NomClasseur 'Ouverture du classeur
Range("K11").Copy
Range("B11") 'Code Projet
Range("K9").Copy 'Service
Range("AI9").Copy 'Nº FEPP
Range("Q9").Copy 'DATE
Range("C9").Copy 'Responsable
Range("C11").Copy 'MP
Range("F10").Copy 'DESIGNATION
Range("AG13").Copy 'REFERENCE
Range("T16").Copy 'INTITULE
Range("BH12").Copy 'BEP
Range("BH17").Copy 'BEM
Range("BH24").Copy 'MTC
Range("BH29").Copy 'QP
Range("BD35").Copy 'QDP
Range("BV35").Copy 'MDC
Range("BH40").Copy 'LOP
Range("BH49").Copy 'HA
Range("BT49").Copy 'Pilote Usine
Range("AY58").Copy 'Industrialisation
Range("BV58").Copy 'Manufacturing
Range("BN64").Copy 'DOM
Range("D68").Copy 'DATE DE CREATION
Range("M68").Copy 'Responsable BE
Range("AI68").Copy 'CPP
Range("AC9").Copy 'Delai de réponse
Range("BN64").Copy 'date LANCEMENT
Range("AX61").Copy 'ACCORD LANCEMENT
Workbooks("EVOLUTION FEP.xlsm").Activate 'on revient sur le classeur
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 'on recherche la dernière ligne vide de la feuille
Range("A10" & DerLigne).Select 'On se positionne sur la dernière ligne de la feuille
ActiveSheet.Paste 'Je colle les données
Workbooks(NomClasseur).Close 'Fermeture du classeur ouvert
NomClasseur = Dir 'On passe au prochain classeur
Wend
' DerLigneTable = ActiveSheet.UsedRange.Rows.Count + 1
Cells.EntireColumn.AutoFit 'On auto-ajuste les colonnes
Range("A1").Select
End Sub
yg_be
Messages postés
22720
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 avril 2024
1 476
26 avril 2020 à 17:22
26 avril 2020 à 17:22
ok, je vois mieux. peux-tu utiliser les balises de code pour afficher ton code ici?
https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
yg_be
Messages postés
22720
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 avril 2024
1 476
26 avril 2020 à 17:29
26 avril 2020 à 17:29
tu peux, par exemple, copier ainsi:
ou bien
Workbooks("EVOLUTION FEP.xlsm").sheets("nomdelafeuille").cells(DerLigne,"E")= _
Workbooks(NomClasseur).sheets("nomdelautrefeuille").[C9]
ou bien
dim fsource as worksheet, fdest as worksheet
set fsource=Workbooks(NomClasseur).sheets("nomdelautrefeuille")
set fdest=Workbooks("EVOLUTION FEP.xlsm").sheets("nomdelafeuille")
fdest.cells(DerLigne,"E")= fsource.[C9]
Pio.roro
>
yg_be
Messages postés
22720
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 avril 2024
26 avril 2020 à 18:16
26 avril 2020 à 18:16
Je dois extraire les données des cellule (B11; K9...) dans les fichiers FEP ( nº 1; nº 2; nº3, ....) et les copier dans le fichier de synthèse EVOLUTION FEP. Feuille Suivi FEP
Comment je fais pour consolider chaque FEP dans le tableau de synthèse par ligne?
Je suis perdu!
Comment je fais pour consolider chaque FEP dans le tableau de synthèse par ligne?
Je suis perdu!
yg_be
Messages postés
22720
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 avril 2024
1 476
>
Pio.roro
26 avril 2020 à 18:59
26 avril 2020 à 18:59
tu n'as toujours pas utilisé les balises de code.
comprends-tu le code que tu as partagé?
as-tu une question au sujet du code que j'ai partagé?
comprends-tu le code que tu as partagé?
as-tu une question au sujet du code que j'ai partagé?
Pio.roro
Messages postés
1
Date d'inscription
dimanche 26 avril 2020
Statut
Membre
Dernière intervention
26 avril 2020
>
yg_be
Messages postés
22720
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 avril 2024
26 avril 2020 à 19:36
26 avril 2020 à 19:36
Hello
Mon code oui. Le votre non.
Je ne suis pas un expert en programmation.
La déclaration des variables, non plus.
Mon code oui. Le votre non.
Je ne suis pas un expert en programmation.
La déclaration des variables, non plus.
