Compilation de fichier sur tous les onglets

Ben78

XLDnaute Nouveau
Bonjour,

Je me permets de vous solliciter car je rencontre une difficulté dans l’établissement d’une macro ; en effet je me rend compte que sans pratique on oublie vite…. Ma cible est la suivante :

J'ai 250 fichiers Excel dans un répertoire contenant un nombre variable d’onglets (jusqu’à 25), tous les onglets ayant la même structure, je dois compiler le contenu de tous ces onglets dans un fichier destination sur un seul onglet.

Après recherches sur le forum j'ai trouvé le code ci-dessous qui répond parfaitement à mon besoin (je me suis d'ailleurs permis de le commenter pour assurer ma bonne compréhension), à un détail près c'est qu'il n'intervient que sur le premier onglet, il me faut réaliser une boucle pour traiter tous les onglets... et c'est là que je bloque... vous serait il possible de m'orienter?

De plus dans la ligne de compilation je ne comprends la fonction Resize(derligne - 2, 27) je serais preneur de son utilité.

Un grand merci de votre aide
Benoit

Code:
Sub Compilation()

'bloque l'affichage
Application.ScreenUpdating = False

'defini la variable compil comme le classeur actif
Set Compil = ThisWorkbook

'efface les precedents traitements
Compil.Sheets(1).Range("A1:AA50000").Clear

'defini le répertoire actif
chemin = Compil.Path & "\"

'defini monFichier comme le repertoire et le fichier excel
monFichier = Dir(chemin & "*.xlsx")

'fait tourner la boucle tant que le nom de fichier est pas vide
Do While monFichier <> ""

' si le fichier traité est différent du fichier des destination alors
    If monFichier <> Compil.Name Then
    
    'ouverture du fichier à traiter
        Set f = Workbooks.Open(chemin & monFichier)
        
        'se place à la dernier ligne complete du premier onglet du fichier à traiter
        derligne = f.Sheets(1).Range("A65000").End(xlUp).Row
        
        'insere le nom du fichier en colone A (pour l'instant c'est du luxe aussi je le met de coté)
        'Compil.Sheets(1).Range("A65000").End(xlUp).Offset(1, 0).Resize(derligne - 2, 1).Value = monFichier
        
        'se place sur le premier onglet et copie de A4 à AA"derniere ligne active et compile dans le fichier de destination"
        f.Sheets(1).Range("A4:AA" & derligne).Copy _
            Compil.Sheets(1).Range("A65000").End(xlUp).Offset(1, 0).Resize(derligne - 2, 27)
        
        'ferme le fichier traité
        f.Close
    
    'fin de la boucle
    End If
    monFichier = Dir
Loop

'debloque l'affichage
Application.ScreenUpdating = True
End Sub
 

Dranreb

XLDnaute Barbatruc
Re : Compilation de fichier sur tous les onglets

Bonjour.
Essayez comme ça :
VB:
Sub Compilation()
Dim PlgDest As Range, NomFic As String, Clas As Workbook, Feui As Worksheet, NbL As Long
Application.ScreenUpdating = False 'bloque l'affichage
Set PlgDest = ThisWorkbook.Worksheets(1).[A1:AA1]
PlgDest.Resize(50000).Clear 'efface les precedents traitements
NomFic = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While NomFic <> "" 'fait tourner la boucle tant que le nom de fichier est pas vide
    If NomFic <> ThisWorkbook.Name Then ' si le fichier traité est différent du fichier des destination alors
        Set Clas = Workbooks.Open(ThisWorkbook.Path & "\" & NomFic)  'ouverture du fichier à traiter
        For Each Feui In Clas.Worksheets
            NbL = Feui.Cells(Feui.Rows.Count, 1).End(xlUp).Row - 3 ' dernière ligne renseignée de la colonne A - 3 lignes…
            Feui.[A4:AA4].Resize(NbL).Copy PlgDest ' copy depuis la ligne 4, qui suit donc les 3 1ères ignorées.
            Set PlgDest = PlgDest.Offset(NbL) 'pour le suivant s'il y a lieu
            Next Feui
        Clas.Close 'ferme le fichier traité
        End If: Loop 'fin de la boucle
Application.ScreenUpdating = True 'debloque l'affichage
End Sub
 

Ben78

XLDnaute Nouveau
Re : Compilation de fichier sur tous les onglets

Bonjour,

et merci de votre intérêt pour ma question, par contre il semble que la boucle tourne sans fin, pourtant une fin de boucle semble bien présente ???

Cordialement
Benoit
 

Ben78

XLDnaute Nouveau
Re : Compilation de fichier sur tous les onglets

Un grand Merci Dranreb le fichier s’exécute bien

Le code final est donc
Code:
Sub Compilation()
Dim PlgDest As Range, NomFic As String, Clas As Workbook, Feui As Worksheet, NbL As Long
Application.ScreenUpdating = False 'bloque l'affichage
Set PlgDest = ThisWorkbook.Worksheets(1).[A1:AA1]
PlgDest.Resize(50000).Clear 'efface les precedents traitements
NomFic = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While NomFic <> "" 'fait tourner la boucle tant que le nom de fichier est pas vide
   If NomFic <> ThisWorkbook.Name Then ' si le fichier traité est différent du fichier des destination alors
       Set Clas = Workbooks.Open(ThisWorkbook.Path & "\" & NomFic)  'ouverture du fichier à traiter
       For Each Feui In Clas.Worksheets
            NbL = Feui.Cells(Feui.Rows.Count, 1).End(xlUp).Row - 3 ' dernière ligne renseignée de la colonne A - 3 lignes…
           Feui.[A4:AA4].Resize(NbL).Copy PlgDest ' copy depuis la ligne 4, qui suit donc les 3 1ères ignorées.
           Set PlgDest = PlgDest.Offset(NbL) 'pour le suivant s'il y a lieu
           Next Feui
        Clas.Close 'ferme le fichier traité
       End If: NomFic = Dir
       Loop 'fin de la boucle
Application.ScreenUpdating = True 'debloque l'affichage
End Sub

Pour ma compréhension et l’adaptation de ce code vous serait il possible de m'indiquer à quoi correspond PlgDest.Resize(50000) => s'agit-il de la sélection des 50 000 premières lignes?

Pour compléter le traitement:
il me serait nécessaire de répliquer sur chaque ligne du fichier source une série de donnée figurant en entête (dans les 3eres lignes qui ne sont pas reprises), donc de copier la plage A2:H2 de tous les onglets et de coller ces valeurs sur chaque ligne
Pour ce faire j'imagine que cela peut s'intégrer sous la ligne NbL = Feui.Cells(Feui.Rows.Count, 1).End(xlUp).Row - 3 sous la forme
Code:
 Range("A2:H2").Select
    Selection.Copy
    Range("R5").Select
    ActiveSheet.Paste
par contre je ne vois pas comment utiliser la variable Nbl pour faire coller sur toutes les lignes non vides???

Cordialement
Benoit
 

Dranreb

XLDnaute Barbatruc
Re : Compilation de fichier sur tous les onglets

PlgDest.Resize(50000) => s'agit-il de la sélection des 50 000 premières lignes?
Resize est une méthode de l'objet Range qui renvoie un autre Range commençant par la même cellule mais avec un nombre de lignes et, si spécifié, de colonnes, différents. PlgDest représentant A1:AA1, PlgDest.Resize(50000) représente donc A1:AA50000.

Non évitez les Select et Selection.
VB:
Feui.[A2:H2].Copy PlgDest.Offset(, PlgDdest.Columns.Count).Resize(NbL, 8)
 

Ben78

XLDnaute Nouveau
Re : Compilation de fichier sur tous les onglets

Bonsoir,

et merci pour ces explications, malheureusement en ajoutant la ligne Excel s’arrête en recherchant un objet... aussi pour être le plus clair possible je me suis permis d'ajouter une petite PJ en zip avec 2 fichiers sources, et le fichier de compilation.

Cordialement
Benoit
 

Pièces jointes

  • illustration.zip
    40.4 KB · Affichages: 29
  • illustration.zip
    40.4 KB · Affichages: 26
  • illustration.zip
    40.4 KB · Affichages: 24

Dranreb

XLDnaute Barbatruc
Re : Compilation de fichier sur tous les onglets

Qu'est ce que j'ai écrit ? C'est PlgDest pas PlgDdest ! Enlevez le second d.
Mais mettez ça dans un module ordinaire, non ? ThisWorkbook n'est pas sa place, à moins qu'il doive être invoqué par une Workbook_Open ou quelque chose comme ça.
 

Ben78

XLDnaute Nouveau
Re : Compilation de fichier sur tous les onglets

Bonjour et toutes mes excuses pour ne pas avoir vu le point, cela fonctionne si ce n'est que les deux traitements se superposent en effet les données d’entête sont rapatriées dans le fichier de destination (en laissant une vingtaine de lignes blanches) puis les données des lignes viennent les écraser comment peut-on décaler la plage de destination?

Cordialement
Benoit
 

Dranreb

XLDnaute Barbatruc
Re : Compilation de fichier sur tous les onglets

Bonjour.
Je comprend rien.
Normalement cette instruction
VB:
Feui.[A2:H2].Copy PlgDest.Offset(, PlgDest.Columns.Count).Resize(NbL, 8)
doit faire ce que vous demandiez: Copier de chaque feuille A2:H2 à toutes les lignes copiées par ailleurs dans la feuille destination. J'ai supposé que c'était à mettre à partir de la colonne AB, et je le met donc en PlgDest décalé de son propre nombre de colonnes, alors il ne devrait pas y avoir d'écrasement.
 
Dernière édition:

StephGuerain

XLDnaute Nouveau
Re : Compilation de fichier sur tous les onglets

Bonjour à tous,

j'ai à peu près le même type de requète mais à une différence près, je souhaite que la macro me copie qu'une seule fois la première ligne et qu'ensuite elle copie colle toutes les lignes qui ont la colonne A de renseignée uniquement.

J'espère que je suis compréhensible, je me suis servi du code ci-dessous.

D'avance merci de votre aide

Steph

Sub Compilation()
Dim PlgDest As Range, NomFic As String, Clas As Workbook, Feui As Worksheet, NbL As Long
Application.ScreenUpdating = False 'bloque l'affichage
Set PlgDest = ThisWorkbook.Worksheets(1).[A1:AA1]
PlgDest.Resize(50000).Clear 'efface les precedents traitements
NomFic = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While NomFic <> "" 'fait tourner la boucle tant que le nom de fichier est pas vide
If NomFic <> ThisWorkbook.Name Then ' si le fichier traité est différent du fichier des destination alors
Set Clas = Workbooks.Open(ThisWorkbook.Path & "\" & NomFic) 'ouverture du fichier à traiter
For Each Feui In Clas.Worksheets
NbL = Feui.Cells(Feui.Rows.Count, 1).End(xlUp).Row - 0 ' dernière ligne renseignée de la colonne A - 3 lignes…
Feui.[A8:AB8].Resize(NbL).Copy PlgDest ' copy depuis la ligne 8, qui suit donc les 7 1ères ignorées.
Set PlgDest = PlgDest.Offset(NbL) 'pour le suivant s'il y a lieu
Next Feui
Clas.Close 'ferme le fichier traité
End If: NomFic = Dir
Loop 'fin de la boucle
Application.ScreenUpdating = True 'debloque l'affichage
End Sub
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
524

Statistiques des forums

Discussions
312 225
Messages
2 086 411
Membres
103 201
dernier inscrit
centrale vet