Synthese
Pio
-
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je possède sur un projet n fiches évolutions. Le format et le même pour toutes ces fiches.
FEPP_1
FEPP_2
FEPP_n
Je voudrais faire un copier/coller de certaines cellules de tous ces fichiers afin d'obtenir une synthèse.
Merci pour votre aide
Slts
Pio
Je possède sur un projet n fiches évolutions. Le format et le même pour toutes ces fiches.
FEPP_1
FEPP_2
FEPP_n
Je voudrais faire un copier/coller de certaines cellules de tous ces fichiers afin d'obtenir une synthèse.
Merci pour votre aide
Slts
Pio
Configuration: Android / Chrome 81.0.4044.117
A voir également:
- Synthese
- Pour lire un document, une personne non-voyante utilise un logiciel qui lui restitue le texte par synthèse vocale. pour y naviguer aisément, le document doit respecter certaines règles d’accessibilité. dans le document à télécharger, vers quels titres de chapitre une personne non-voyante peut-elle aller directement sans avoir à tout lire ? - Forum Réseaux sociaux
- Synthèse rapport de stage - Guide
- Film en images de synthèse ✓ - Forum TV & Vidéo
- Créer une voix de synthèse - Forum Logiciels
- Voix de synthèse française pour Dspeech - Forum Création et production musicale
2 réponses
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
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
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
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]