Compiler des tableaux à la suite
Résolu/Fermé
Herkabe
Messages postés
17
Date d'inscription
dimanche 31 mars 2019
Statut
Membre
Dernière intervention
14 juin 2019
-
12 juin 2019 à 09:48
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 12 juin 2019 à 18:50
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 12 juin 2019 à 18:50
A voir également:
- Compiler des tableaux à la suite
- Tableaux croisés dynamiques - Guide
- Le fichier contient une liste de prénoms. triez ce tableau par ordre alphabétique des prénoms. quel mot est formé par les 6 premières lettres de la colonne code ? - Forum Bureautique
- Clémence souhaite faire calculer automatiquement les prix de 30 produits dans trois devises. elle a déjà saisi une formule de calcul pour le tarif du premier produit dans la première devise. corrigez sa formule afin que recopiée vers le bas puis vers la droite, elle remplisse correctement tout le tableau. - Forum Excel
- Compiler pdf - Guide
- Fusionner deux tableaux excel - Guide
4 réponses
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 762
Modifié le 12 juin 2019 à 10:39
Modifié le 12 juin 2019 à 10:39
Bonjour,
Je suppose que tes tableaux commencent en A6 (sinon corriges la constante adr) :
Cordialement
Patrice
Je suppose que tes tableaux commencent en A6 (sinon corriges la constante adr) :
Option Explicit
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 etc As Boolean 'En tête copié
Const adr$ = "A6" 'Adresse de la première cellule des tableaux à copier
' 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)
' Définir le tableau à copier
Set rng = wbk.Worksheets(1).Range(adr).CurrentRegion
' Si l'en-tête est déjà copié ....
If etc Then
' ... reduire le tableau aux données sans en-tête
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
End If
' Copier le tableau
rng.Copy dst
' En-tête copié
etc = True
' Destination suivante
Set dst = dst.Offset(rng.Rows.Count)
' Fermer le fichier sans le modifier
wbk.Close False
End If
Next fic
End Sub
Cordialement
Patrice
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 762
Modifié le 12 juin 2019 à 12:34
Modifié le 12 juin 2019 à 12:34
Re,
Mais il ne s'agit pas de tableaux !!!! - A mauvaise question : mauvaise réponse ....
(un tableau ne comporte pas de ligne vide, ni de colonne vide)
En outre, il ne fallait pas enlever le $ sur la ligne :
Avec ce genre de feuille, il faut savoir quelle est la colonne qui est obligatoirement remplie pour déterminer où se situe la dernière ligne. je suppose que c'est la F :
Cordialement
Patrice
Mais il ne s'agit pas de tableaux !!!! - A mauvaise question : mauvaise réponse ....
(un tableau ne comporte pas de ligne vide, ni de colonne vide)
En outre, il ne fallait pas enlever le $ sur la ligne :
Const adr$ = "A6"si tu veux l'enlever il faut écrire :
Const adr As String = "A6"
Avec ce genre de feuille, il faut savoir quelle est la colonne qui est obligatoirement remplie pour déterminer où se situe la dernière ligne. je suppose que c'est la F :
Option Explicit
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 etc As Boolean 'En tête copié
Const lig$ = "5" 'Adresse de la première ligne des tableaux à copier
Const col$ = "F" 'Adresse de la colonne à tester
' Définir le répertoire à lire
pth = ThisWorkbook.Path & "\tmp"
' 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)
' Définir les lignes à copier
With wbk.Worksheets(1)
Set rng = .Rows(lig & ":" & .Cells(.Rows.Count, col).End(xlUp).Row)
End With
' Si l'en-tête est déjà copié ....
If etc Then
' ... réduire les lignes aux données sans en-tête
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
End If
' Copier les lignes entières
rng.Copy dst
' En-tête copié
etc = True
' Destination suivante
Set dst = dst.Offset(rng.Rows.Count)
' Fermer le fichier sans le modifier
wbk.Close False
End If
Next fic
End Sub
Cordialement
Patrice
Herkabe
Messages postés
17
Date d'inscription
dimanche 31 mars 2019
Statut
Membre
Dernière intervention
14 juin 2019
Modifié le 12 juin 2019 à 11:16
Modifié le 12 juin 2019 à 11:16
Bonjour, et merci pour ta réponse.
Malheureusement, la macro ne se contente plus que de recopier une seule cellule (A5), en A1 de la nouvelle feuille et... je ne comprends pas pourquoi (j'ai enlevé le $ à côté du adr au début pourtant, et même avec ça faisait la même chose).
J'ai bien mis la macro dans un nouveau module avec Option Explicit.
Ci-joint une capture d'écran pour montrer la mise en forme du tableau un peu particulière, ça aidera sûrement.

EDIT : Et du coup non le tableau commence véritablement en A5, mais pour compter les colonnes j'ai pris en A6 car les en-tête vont plus loin qu'en A5.
Malheureusement, la macro ne se contente plus que de recopier une seule cellule (A5), en A1 de la nouvelle feuille et... je ne comprends pas pourquoi (j'ai enlevé le $ à côté du adr au début pourtant, et même avec ça faisait la même chose).
J'ai bien mis la macro dans un nouveau module avec Option Explicit.
Ci-joint une capture d'écran pour montrer la mise en forme du tableau un peu particulière, ça aidera sûrement.

EDIT : Et du coup non le tableau commence véritablement en A5, mais pour compter les colonnes j'ai pris en A6 car les en-tête vont plus loin qu'en A5.
Herkabe
Messages postés
17
Date d'inscription
dimanche 31 mars 2019
Statut
Membre
Dernière intervention
14 juin 2019
12 juin 2019 à 14:01
12 juin 2019 à 14:01
Désolé pour mon imprécision, j'aurais du me renseigner davantage avant de poser ma question.
Ceci, merci beaucoup pour ton code patrice, sujet résolu!
Ceci, merci beaucoup pour ton code patrice, sujet résolu!
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 762
12 juin 2019 à 18:50
12 juin 2019 à 18:50
De rien.
En regardant l'image de ton tableau il y a 2 lignes de titre (ou 3 avec la première ligne vide)
Pour éviter le copier les lignes 2 et 3 des autre feuilles, tu peux remplacer :
En regardant l'image de ton tableau il y a 2 lignes de titre (ou 3 avec la première ligne vide)
Pour éviter le copier les lignes 2 et 3 des autre feuilles, tu peux remplacer :
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)Par
Set rng = rng.Offset(3).Resize(rng.Rows.Count - 3)