Rousseau Benoit
XLDnaute Nouveau
Bonjour,
je ne suis pas du tout un expert de VBA mais j'ai besoin de consolider de manière pratique des fichiers .xls présentant plusieurs onglets (3). Cependant les données que je souhaite consolider sont toutes dans un onglet rigoureusement identique appelé "List".
J'ai trouvé et adapté la macro VBA suivante (cf. ci-dessous). Cependant je suis incapable de déclarer dans la boucle que je veux comme onglet actif pour chaque classeur l'onglet "List". De ce fait la macro ne fonctionne pas sur les fichiers que j'ai à traiter...
Je vous serez sincèrement reconnaissant de l'aide que vous pourrez m'apporter.
Bien cordialement
benoit
Option Explicit
'Declaration des variables à savoir les fichiers'
Dim NomClasseur As String
Dim LigneTotal As Integer
Dim DerLigne As Integer
'Procédure de consolidations de décla EU'
Sub Consolider()
'Etape 1: création des entêtes'
Range("A1").Value = "EU Submission *"
Range("B1").Value = "n° agrément"
Range("C1").Value = "n° d'EU sur APAFiS"
Range("D1").Value = "n° de la demande"
Range("E1").Value = "Animal Species*"
Range("F1").Value = "Specify other"
Range("G1").Value = "Re-use*"
Range("h1").Value = "PLace of birth (origin)"
Range("L1").Value = "Genetic status*"
Range("M1").Value = "Creation of new GL*"
Range("N1").Value = "Purpose"
Range("o1").Value = "specicify other"
Range("p1").Value = "testing by legislation"
Range("q1").Value = "specicify other"
Range("r1").Value = "legilative Requirements"
Range("s1").Value = "Severity*"
Range("t1").Value = "fichier source"
Range("A1:s1").Interior.Color = vbBlue 'couleur de rempli'
Range("A1:s1").Font.Color = vbWhite 'couleur de la police'
Range("S1").Font.Bold = True
'Parcours des fichiers du dossier'
ChDir "C:\Users\XXX\Desktop\EN" 'à changer en fonction de ton emplacement'
NomClasseur = Dir("C:\Users\XXX\Desktop\EN\*.xls")
'boucle de recherche des classeurs'
While Len(NomClasseur) > 0
Application.DisplayAlerts = False
Workbooks.Open NomClasseur 'ouverture des classeurs'
LigneTotal = ActiveSheet.UsedRange.Rows.Count 'récupération du nb de lignes/fichier'
Range("A4:s" & LigneTotal).Copy
Workbooks("Consolidation.xlsm").Activate
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 'recherche la dernière ligne'
Range("A" & DerLigne).Select
ActiveSheet.Paste
Range("T" & DerLigne & ":T" & ActiveSheet.UsedRange.Rows.Count) = NomClasseur
Workbooks(NomClasseur).Close
NomClasseur = Dir
Wend
'suppression des extensions'
Columns("T:T").Replace ".xls", ""
End Sub
je ne suis pas du tout un expert de VBA mais j'ai besoin de consolider de manière pratique des fichiers .xls présentant plusieurs onglets (3). Cependant les données que je souhaite consolider sont toutes dans un onglet rigoureusement identique appelé "List".
J'ai trouvé et adapté la macro VBA suivante (cf. ci-dessous). Cependant je suis incapable de déclarer dans la boucle que je veux comme onglet actif pour chaque classeur l'onglet "List". De ce fait la macro ne fonctionne pas sur les fichiers que j'ai à traiter...
Je vous serez sincèrement reconnaissant de l'aide que vous pourrez m'apporter.
Bien cordialement
benoit
Option Explicit
'Declaration des variables à savoir les fichiers'
Dim NomClasseur As String
Dim LigneTotal As Integer
Dim DerLigne As Integer
'Procédure de consolidations de décla EU'
Sub Consolider()
'Etape 1: création des entêtes'
Range("A1").Value = "EU Submission *"
Range("B1").Value = "n° agrément"
Range("C1").Value = "n° d'EU sur APAFiS"
Range("D1").Value = "n° de la demande"
Range("E1").Value = "Animal Species*"
Range("F1").Value = "Specify other"
Range("G1").Value = "Re-use*"
Range("h1").Value = "PLace of birth (origin)"
Range("L1").Value = "Genetic status*"
Range("M1").Value = "Creation of new GL*"
Range("N1").Value = "Purpose"
Range("o1").Value = "specicify other"
Range("p1").Value = "testing by legislation"
Range("q1").Value = "specicify other"
Range("r1").Value = "legilative Requirements"
Range("s1").Value = "Severity*"
Range("t1").Value = "fichier source"
Range("A1:s1").Interior.Color = vbBlue 'couleur de rempli'
Range("A1:s1").Font.Color = vbWhite 'couleur de la police'
Range("S1").Font.Bold = True
'Parcours des fichiers du dossier'
ChDir "C:\Users\XXX\Desktop\EN" 'à changer en fonction de ton emplacement'
NomClasseur = Dir("C:\Users\XXX\Desktop\EN\*.xls")
'boucle de recherche des classeurs'
While Len(NomClasseur) > 0
Application.DisplayAlerts = False
Workbooks.Open NomClasseur 'ouverture des classeurs'
LigneTotal = ActiveSheet.UsedRange.Rows.Count 'récupération du nb de lignes/fichier'
Range("A4:s" & LigneTotal).Copy
Workbooks("Consolidation.xlsm").Activate
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 'recherche la dernière ligne'
Range("A" & DerLigne).Select
ActiveSheet.Paste
Range("T" & DerLigne & ":T" & ActiveSheet.UsedRange.Rows.Count) = NomClasseur
Workbooks(NomClasseur).Close
NomClasseur = Dir
Wend
'suppression des extensions'
Columns("T:T").Replace ".xls", ""
End Sub
