Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

[XL 2013-2016] Compiler des tableaux à la suite


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    juin 2019
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Communication - Médias

    Informations forums :
    Inscription : juin 2019
    Messages : 13
    Points : 10
    Points
    10
    Par défaut [XL 2013-2016] Compiler des tableaux à la suite
    Bonjour,

    J'ai créé un compilateur en arrangeant un code trouvé sur internet selon mon besoin.
    Ce compilateur doit me permettre, indépendamment du format des tableaux à compiler (qui ont tous la même forme selon le type de données), de copier les valeurs de tableaux contenus dans différents classeurs afin de les assembler dans un nouveau classeur.

    Oui mais voilà, étant novice en VBA, mon code fonctionne mal, et j'ai du mal à trouver les erreurs dans le code.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    Sub Regrouper_Fichiers()
     
    Dim fso As Object               'Système de fichiers
    Dim rep As Object               'Répertoire
    Dim cfr As Object               'Collection de fichiers du répertoire
    Dim fic As Object               'Fichier (élément de la collection cfr)
    Dim wbk As Workbook             'Classeur
    Dim res As Workbook             'Classeur resultat
    Dim rng As Range                'Plage de cellules
    Dim dst As Range                'Cellule de destination
    Dim pth As String               'Chemin du répertoire
    Dim i As Integer
    ' Définir le répertoire à lire
    pth = "C:\Users\Herkabe\Desktop\Reporting WC\Flux Achats-Ventes"
     
    ' Créer le fichier résultat
    Set res = Workbooks.Add(xlWBATWorksheet)
    Set dst = res.Worksheets(1).Range("A1")
     
    ' Lecture du répertoire
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rep = fso.GetFolder(pth)
    Set cfr = rep.Files
     
    ' Contrôler chaque fichier du répertoire
    For Each fic In cfr
     
      ' - Vérifier s'il s'agit d'un fichier Excel...
      If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 Then
     
        ' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
        Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
     
        ' Compte le nombre de colonnes à copier
        dercol = Cells(6, Columns.Count).End(xlToLeft).Column
     
        ' Copie les colonnes une par une
        For i = 1 To dercol Step 1
     
        ' Copier la colonne
        Set rng = wbk.Worksheets(1).UsedRange
        rng.Copy dst
     
        Next
        ' Fermer le fichier sans le modifier
        wbk.Close False
     
        ' Destination suivante
        With res.Worksheets(1)
          Set dst = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
     
     
     
      End If
    Next fic
     
    End Sub
    Je rencontre deux problèmes :

    -Après avoir copié un tableau correctement, la macro copie seulement les en-tête des tableaux suivants et les colle après l'en-tête du premier tableau, sur les données!

    -Le deuxième problème vous l'aurez compris, la macro copie les en-tête de tous les tableaux alors que ce n'est pas nécessaire. Comme ils ont tous la même en-tête, la copier une seule fois suffit...

    Je m'en remets à vous. Au plaisir de vous lire. Merci.

  2. #2
    Expert confirmé Avatar de MarcelG
    Homme Profil pro
    Développeur informatique
    Inscrit en
    juillet 2009
    Messages
    2 885
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 885
    Points : 5 898
    Points
    5 898
    Par défaut
    Bonjour Harkebe et bienvenu sur le Forum,

    Le compteur i n'est pas utilisé dans le bloc For.. Next
    D'autre part:
    - Plutôt que de considérer - dangereusement - les cellules utilisées, préférer la définition de la plage à copier.
    - Tu devrais effectuer ta copie en bloc, par plage de la 1ère cellule en haut à gauche à la dernière en bas à droite. Celle-ci étant - trivialement - définie par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Cells(derligne, dercolonne)
    Ceci en sachant aussi que la cellule de destination sera décalée du nombre de lignes copiées.

    Pourrai-tu essayer de développer en ce sens, procéder à un essai et revenir.
    Je te conseillerais d'observer d'abord la copie manuelle sur le tableur, pour 1 ou 2 fichiers, puis de te pencher sur le code.

    Au niveau de débutant, ce code peut être satisfaisant.
    Notre ami doit être bien rigoureux dans les méthodes utilisées.

    Une autre solution aurait été de compléter un tableau à 2 dimensions pour chaque fichier, à l'aide d'une fonction SommeTablo, que je reporterai à toute fin utile.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    MonTablo = SommeTablo(MonTablo, tablofichier)
    En fin de boucle, la plage de destination serait égale à la transposition du tableau final MonTablo

    Bien Cordialement.

    Marcel

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.



  3. #3
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    juin 2019
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Communication - Médias

    Informations forums :
    Inscription : juin 2019
    Messages : 13
    Points : 10
    Points
    10
    Par défaut
    Bonjour Marcel et merci pour votre réponse!

    Je vais essayer d'appliquer ce que vous me dites, mais ça risque de me prendre un peu de temps, je reviendrai une fois cela fait.

  4. #4
    Expert confirmé Avatar de MarcelG
    Homme Profil pro
    Développeur informatique
    Inscrit en
    juillet 2009
    Messages
    2 885
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 885
    Points : 5 898
    Points
    5 898
    Par défaut
    Salut,

    Pour t'aiguiller
    - Définition de la cellule de destination sur le classeur récipiendaire
    Set dest = Range(...
    - Ouverture en boucle des fichiers
    - Pour chacun, définition de la plage à copier et copie
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    .Range("A2", .Cells(derligne,dercol).Copy Destination:=dest
    - Annulation du mode copy
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Application.Cutcopymode = False
    - Fermeture du fichier annexe sans sauvegarde
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    .Close Savechanges:=False
    - Redéfinition de la cellule de dstination
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set dest = dest.Offset(derligne-1,0)
    (bien évidemment à adapter)

    Attention de bien rattacher tes objets Range à leur feuille Parent par un "." en utilisant éventuellement le bloc With..End With

    Bien Cordialement.

    Marcel

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.



  5. #5
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    juin 2019
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Communication - Médias

    Informations forums :
    Inscription : juin 2019
    Messages : 13
    Points : 10
    Points
    10
    Par défaut
    Enfin ça y est, ça marche!

    Merci beaucoup Marcel pour votre aide précieuse, vous m'avez sacrément mâché le travail je dois le reconnaître.
    Il ne me reste plus qu'à trouver un moyen de supprimer les en-tête et données inutiles après la premières copie (ou après toutes les copies je verrais).

    Je laisse le code en bas si jamais ça peut aider d'autres personnes. Topic résolu.

    Merci encore Marcel pour votre aide, et au plaisir de vous revoir.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    Public Sub Test()
     
    Dim fso As Object               'Système de fichiers
    Dim rep As Object               'Répertoire
    Dim cfr As Object               'Collection de fichiers du répertoire
    Dim fic As Object               'Fichier (élément de la collection cfr)
    Dim wbk As Workbook             'Classeur
    Dim res As Workbook             'Classeur resultat
    Dim rng As Range                'Plage de cellules
    Dim dst As Range                'Cellule de destination
    Dim pth As String               'Chemin du répertoire
     
    ' Définir le répertoire à lire
    pth = "C:\Users\Herkabe\Desktop\Reporting WC\Flux Achats-Ventes"
     
    ' Créer le fichier résultat
    Set res = Workbooks.Add(xlWBATWorksheet)
    Set dst = res.Worksheets(1).Range("A1")
     
    ' Lecture du répertoire
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rep = fso.GetFolder(pth)
    Set cfr = rep.Files
     
    ' Contrôler chaque fichier du répertoire
    For Each fic In cfr
     
      ' - Vérifier s'il s'agit d'un fichier Excel...
      If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 Then
     
        ' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
        Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
     
        dercol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
        derlig = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
     
        wbk.Worksheets(1).Range(Cells(1, 1), Cells(derlig, dercol)).Copy Destination:=dst
     
        Application.CutCopyMode = False
        wbk.Close SaveChanges:=False
     
        With res.Worksheets(1)
            Set dst = dst.Offset(derlig - 1, 0)
        End With
     
      End If
    Next fic
     
    End Sub

  6. #6
    Expert confirmé Avatar de MarcelG
    Homme Profil pro
    Développeur informatique
    Inscrit en
    juillet 2009
    Messages
    2 885
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 885
    Points : 5 898
    Points
    5 898
    Par défaut
    Salut Harkebe,

    Tant que le code ne donne pas pleine satisfaction, il te faut y retourner.

    Plusieurs remarques:

    1 - Pour les définitions de dernière ligne et dernière colonne, tu proscris les méthodes SpecialCells et UsedRange.
    Il peut toujours y avoir une mise en forme, un espace qui puisse t'induire en erreur.
    Pour ce faire
    - la bonne vieille méthode End(xl..) dont la génération d'erreur est rarissime
    - la méthode qui consiste à trouver un caractère depuis le bas/la droite de la feuille (en sens inverse donc) (méthode Patrick)

    2 - Pour accentuer la lisibilité du code, ne pas hésiter à utiliser le bloc With

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    With wbk.Worksheets(1).
     .Range(.Cells(1, 1), .Cells(derlig, dercol)).Copy Destination:=dst
    End With
    Tu remarqueras les '." nécessaires au rattachement - fondamental - des objets Range.

    3 - Si la 1ère ligne de chaque fichier est affectée aux titres des champs, alors une variable de l'objet Cells(1,1) serait à changer.
    Je te laisse trouver.

    4 - Il est de bon aloi de libérer les variables affectées aux objets (Set...) après utilisation en commençant par la dernière.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set lavariable = Nothing
    Tu reviens en ayant adapté ces remarques.

    Bien Cordialement.

    Marcel

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.



+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Compilé des tableaux en un seul
    Par andre17 dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 20/01/2011, 12h41
  2. Réponses: 0
    Dernier message: 11/11/2010, 09h30
  3. [XL-2003] Copier des tableaux l'un à la suite des autres
    Par Isabelle86 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 26/10/2010, 15h04
  4. probleme de compilation des tableaux sous vista
    Par cesari dans le forum Tableaux - Graphiques - Images - Flottants
    Réponses: 5
    Dernier message: 27/04/2008, 20h37
  5. ajouter à la suite des tableaux
    Par vic_cw dans le forum C++
    Réponses: 9
    Dernier message: 22/08/2004, 16h11

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo