Regrouper plusieurs feuilles sur une autre. (2003-2010)

**Philippe Tulliez** · 08/01/2013, 12h45

Bonjour,
Le regroupement de plusieurs feuilles sur une autre est une question récurrente dans les forums Excel.
Je viens de développer une procédure (Function) nommée ExportTable qui copie une feuille sur une autre.
Cette procédure renvoie le nombre de lignes que contient la feuille cible et contient cinq arguments dont trois sont optionnels.
La procédure contrôle si la ligne de titre de la feuille cible est identique à celle de la feuille à copier. Si ce n'est pas le cas ne réalise pas la copie.
Ne recopie qu'une seule fois la ligne de titre (au cas où l'argument ClearSheet est à True)

Le classeur Démo
Un classeur de démonstration est joint à ce fil et contient plusieurs feuilles.
MENU - Feuille d'explication contenant un bouton qui lance une boîte de dialogue permettant de sélectionner les feuilles à copier vers la feuille nommée Export et laissant le choix des arguments à passer à la procédure d'exportation.
Export - Est la feuille cible.
Fiche-(x) - Cinq feuilles de même type dont la feuille Fiche-D a une étiquette (Naissance) qui est différente des autres (Naiss) ce qui permet de constater que la procédure ne la copiera pas et enverra un message si l'argument ShowMsg est à True
Mvt-(mmm) - Trois feuilles dont la dernière colonne contient une formule qui permet de tester l'argument ValueOnly

Les arguments
Obligatoires
FromSheet : Feuille d'où viennent les données
TargetSheet : Feuille cible
Optionnels
ValueOnly : Booléen, TRUE copie les valeurs, FALSE (défaut) copie les formules
ClearSheet : Booléen, TRUE, fait un Clear de TargetSheet (Feuille Export), FALSE (Défaut) ajoute après la dernière ligne sans sa ligne de titre).
ShowMsg : Boolean, FALSE n'affiche pas les messages d'incohérence pour les Labels TRUE (Défaut).

La syntaxe
Soit en renvoyant une valeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nbRow = ExportTable(WS, shtExport, ClearSheet:=False, ValueOnly:=True, ShowMsg:=False)

Soit comme méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ExportTable WS, shtExport, ClearSheet:=False, ValueOnly:=True, ShowMsg:=False

Où WS est une variable objet de type WorkSheet et shtExport est le CodeName de la feuille cible.

La procédure

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Private Function ExportTable(FromSheet As Worksheet, TargetSheet As Worksheet, Optional ValueOnly As Boolean = False, Optional ClearSheet As Boolean = False, Optional ShowMsg As Boolean = True) As Long
 ' Copie données contenues ds feuille (FromSheet) vers feuille (TargetSheet)
 ' Contrainte la 1ère cellule doit être A1
 ' Auhor : Philippe Tulliez http://philippe.tulliez.be
 ' Date  : 08/01/2013 (02/01/2013)
 ' Version 1.1
 ' Update
 ' 00/00/0000-x.x
 ' Arguments
 ' FromSheet   - obj WorkSheet (Feuille d'où viennent les données)
 ' TargetSheet - obj WorkSheet (Feuille cible)
 ' [ValueOnly] - Boolean [d:FALSE] Si TRUE copie les valeurs
 ' [ClearSheet]- Boolean [d:=False] si TRUE, Fait un Clear de TargetSheet (Feuille Export)
 ' [ShowMsg]   - Boolean [d:=True] si False n'affiche pas les messages d'incohérence pour les Labels
 ' *** Déclaration ***
 ' ... Variables messages d'erreurs
 Const ver As String = "V 1.0"
 Const ErrTitle As String = "Procédure - ExportTable " & ver
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 '
 Dim c As Integer
 Dim rngTarget As Range, rngImport As Range
 Dim TargetRow As Long, depl As Integer
 Dim LabelTarget As Range, LabelImport As Range
 Dim AddressNew As String
 '
 If FromSheet.Name = TargetSheet.Name Then Exit Function ' Sortie de procédure
 '
 If ClearSheet And TargetSheet.Range("A1").CurrentRegion.count <> 1 Then TargetSheet.Cells.Clear
 '
 ' *** Assignation ***
 Set rngTarget = TargetSheet.Range("A1").CurrentRegion
 Set rngImport = FromSheet.Range("A1").CurrentRegion
 ' ... Ligne titre (Labels)
 Set LabelTarget = rngTarget.Resize(1, rngTarget.Columns.count)
 Set LabelImport = rngImport.Resize(1, rngImport.Columns.count)
 With rngTarget: TargetRow = .Rows.count + Abs(.Rows.count > 1): End With
 With TargetSheet
  AddressNew = .Range(.Cells(TargetRow, 1), .Cells(TargetRow + rngImport.Rows.count - 1, rngImport.Columns.count)).Address
 End With
 ' *** Start ***
 Select Case rngImport.Rows.count
  Case Is > 1
    depl = Abs((TargetRow > 1))
    Set rngImport = rngImport.Offset(depl).Resize(rngImport.Rows.count - depl)
    With rngImport
     Select Case True
        Case rngTarget.count = 1 ' Pas de 1ère ligne (Labels)
          .Copy TargetSheet.Range("A" & TargetRow)
          If ValueOnly Then TargetSheet.Range(AddressNew).Value = TargetSheet.Range(AddressNew).Value
          ExportTable = rngImport.Rows.count
        Case LabelTarget.count = .Resize(1, .Columns.count).count
          '
          ' Vérification si même nombre de colonne et sortie de fonction
          For c = 1 To LabelTarget.Columns.count
           If UCase(LabelTarget.Cells(1, c)) <> UCase(LabelImport.Cells(1, c)) Then
            ' Envoi du message si ShowMsg = TRUE et sortie de procédure
            If ShowMsg Then
             ErrMsg = ErrMsg _
                & vbCrLf & "Etiquette (" & LabelTarget.Cells(1, c) & ") dans feuille [Export]" _
                & vbCrLf & "Pas identique dans [" & FromSheet.Name & "] (" & LabelImport.Cells(1, c) & ")"
             MsgBox ErrMsg, vbInformation + vbOKOnly, ErrTitle
            End If
            ExportTable = rngTarget.Rows.count: Exit Function
           End If
          Next
          '
          .Copy TargetSheet.Range("A" & TargetRow) ' Copie de plage
          ExportTable = rngTarget.Rows.count + rngImport.Rows.count
          If ValueOnly Then TargetSheet.Range(AddressNew).Value = TargetSheet.Range(AddressNew).Value ' Copie Valeur
        Case Else
          ' Nombre de colonnes ds ligne titre pas identique -> Sortie de procédure
          If ShowMsg Then
           ErrMsg = ErrMsg & "Feuille : " & FromSheet.Name & vbCrLf & "Longueur ligne des titres pas identique"
           MsgBox ErrMsg, vbInformation + vbOKOnly, ErrTitle
          End If
          ExportTable = rngTarget.Rows.count: Exit Function
     End Select
    End With
 End Select
 TargetSheet.Cells.EntireColumn.AutoFit
End Function

Le classeur au format xls a été testé avec la version 2003 et 2010.
Malgré le soin apporté à la programmation de cette procédure et au multiples tests réalisés, il est possible qu'il subsiste une erreur qui m'aurait échappé. N'hésitez pas à m'en faire part.

Vos remarques et réactions sont les bienvenues.

**Akane69** · 02/07/2013, 16h00

Merci,
voila une aide précieuse pour un débutant comme moi.
Est-ce par ailleurs possible d'avoir une macro permettant d'aller chercher et concaténer des feuilles se trouvant dans un ou d'autres classeur(s)?
Merci d'avance pour ton retour.
Cordialement,

**Philippe Tulliez** · 04/07/2013, 12h56

Bonjour,

Est-ce par ailleurs possible d'avoir une macro permettant d'aller chercher et concaténer des feuilles se trouvant dans un ou d'autres classeur(s)?

Pour la procédure ExportTable, c'est tout à fait transparent (que la feuille provienne du même classeur ou d'un autre classeur).

Voici un petit exemple d'une procédure qui rassemble dans une feuille dont le CodeName est shtExport du classeur où se trouve le projet VBA, toutes les feuilles des classeurs se trouvant dans le répertoire sélectionné dans la procédure GetFolder.
Cet exemple considère que toutes les feuilles à rassembler dans la feuille shtExport sont seules dans les classeurs ou tout au moins se trouvent en première position.

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
Sub MainExport()
 Dim Folder As String, FileList() As String, Elem As Long
 Dim wkbFrom As Workbook, ShtFrom As Worksheet
 ' Sélection du répertoire
 Folder = GetFolder(ThisWorkbook.Path & "\"): If Len(Folder) = 0 Then Exit Sub
 ' Renvoie la liste des fichiers présent dans le répertoire (Folder)
 FileList = FileListInFolder(Folder)
 For Elem = 0 To UBound(FileList)
   Set wkbFrom = Workbooks.Open(Folder & FileList(Elem))
   Set ShtFrom = wkbFrom.Worksheets(1)
   Select Case Elem
    Case 0: ExportTable ShtFrom, shtExport, ClearSheet:=True
    Case Else: ExportTable ShtFrom, shtExport
   End Select
   wkbFrom.Close
 Next
 Set wkbFrom = Nothing: Set ShtFrom = Nothing
End Sub

Code de la fonction GetFolder qui renvoie le nom du répertoire sélectionné par l'utilisateur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function GetFolder(Optional StrPath As String) As String
  Dim fdlg As FileDialog, sItem As String
  Set fdlg = Application.FileDialog(msoFileDialogFolderPicker)
  If Len(StrPath) = 0 Then StrPath = Application.ActiveWorkbook.Path & "\"
  With fdlg
  .Title = "Selection d'un répertoire"
  .AllowMultiSelect = False
  .InitialFileName = StrPath
   If .Show = -1 Then GetFolder = .SelectedItems(1)
  End With
 Set fdlg = Nothing
End Function

Code de la fonction FileListInFolder qui renvoie la liste des fichiers contenu dans le répertoire passé à l'argument StrPath

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function FileListInFolder(StrPath As String) As Variant
 Dim FileName As String, Elem As Long, FileList() As String
 If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\"
 FileName = Dir(StrPath)
 Do While FileName <> ""
  If Right(FileName, 4) = ".xls" Then
   ReDim Preserve FileList(Elem): FileList(Elem) = FileName: Elem = Elem + 1
  End If
  FileName = Dir
 Loop
 FileListInFolder = FileList
End Function

**Akane69** · 08/07/2013, 15h35

Bonjour,
merci pour ces précisions. Dans quelle partie du code dois-je rajouter ces éléments (dans sheet menu?)? Faudra t-il que je crée de nouveaux boutons pour les options GetFolder et FileListInFolder?
Etant donné que je suis novice dans la programmation en VBA, ce sera peut être plus simple que tu rajoutes ces éléments du code dans la procédure que tu avais dèjà commencée, j'ai peur de tout gâcher en les rajoutant moi même.
Merci encore pour ton aide.

**Philippe Tulliez** · 08/07/2013, 16h29

Bonjour,
Les trois procédures (MainExport, GetFolder, FileListInFolder) peuvent cohabiter ensemble dans un nouveau module mais peuvent aussi se placer dans le module où se trouve déjà la procédure ExportTable
Tu peux prendre un nouveau classeur avec une feuille dont le CodeName est shtExport.
Eventuellement avoir une feuille où tu places un bouton qui appelle la procédure MainExport qui est la procédure de démarrage et cela fonctionnera tout seul.
Il faut juste sélectionner le répertoire où se trouve les classeurs dont la première feuille contient la liste de données à exporter vers shtExport (toutes les feuilles doivent avoir le même nombre de colonne et avoir les étiquettes de colonnes la même orthographe).

Bonjour,
Voici un fichier exemple au format zip avec dans un répertoire nommé Excel - Export by AdvancedFilter un classeur nommé ExportWorkBookTable - Demo avec une une feuille dont le CodeName est shtExport et feuille [Menu] qui a un bouton qui permet de lancer la procédure MainExport
Ce répertoire contient un sous-répertoire nommé Mvt2003 qui contient quatre classeurs avec les feuilles à importer dans la feuille shtExport.
Il suffit donc de cliquer sur le bouton se trouvant dans la feuille [Menu] pour lancer la procédure, choisir le répertoire mvt2003 et cliquer sur OK.

**Akane69** · 09/07/2013, 14h37

Merci, c'est vraiment magnifique.
Tu sais la seule contrainte majeure sera maintenant d'avoir les mêmes noms de colonnes pour tous les fichiers s'il y'en a beaucoup. Je dois par exemple compiler 654 fichiers qui ont la même structure heureusement. Aurai-tu un moyen d'incorporer les mêmes noms de colonnes dans un répertoire avec des fichiers à structures identiques (même nombre de colonnes...)?

**Philippe Tulliez** · 09/07/2013, 14h51

Bonjour,
En informatique tout est possible et bien entendu qu'il est possible de regrouper des feuilles ayant le même nombre de colonnes mais pas le même nom d'étiquettes mais quand j'écris une procédure je travaille de la façon dont j'organise mes feuilles.
Il suffirait de passer outre la comparaison du nom d'étiquette par l'ajout d'un argument boolean qui ne ferait pas ce test.
Cependant on risque de se retrouver avec des données qui ne sont plus compatibles.
Il vaudrait mieux alors ajouter un rapport d'incohérence. Je regarde cela ce soir.

**Akane69** · 10/07/2013, 12h25

Ok ce serait une aubaine pour moi cela. J'attends donc ton retour.
Merci encore

**had4789** · 23/06/2014, 09h15

Bonjour,

Tout d'abord merci beaucoup pour ce classeur qui est vraiment génial pour un débutant comme moi.

Pourrais-tu me dire comme tu as créer le bouton de la première page?

Merci

**Philippe Tulliez** · 23/06/2014, 09h27

Bonjour,
Merci pour l'appréciation.
Quant au bouton dont tu parles et n'ayant pas mon classeur sous la main, je suppose que c'est un bouton ActiveX placé sur la feuille.
Dans l'onglet [Développeur], groupe Contrôle clic sur la commande Insérer. Cliquer sur le bouton dans Contrôle ActiveX et le dessiner sur la feuille.
Ensuite faire un double clic sur ce bouton et la procédure événementielle concernant ce bouton va s'ouvrir. Et il suffit d'ajouter NomUserForm.Show pour que la boîte de dialogue s'active.

**had4789** · 27/06/2014, 08h58

Bonjour,

Merci de m'avoir expliqué pour le bouton. Encore une fois ça marche super bien.

J'ai encore une petite question, existe t-il un moyen de sélectionné directement les feuilles 2 à 11 par exemple?

Merci par avance

**Fab23** · 17/06/2015, 13h43

Hello Philippe,

Merci pour ta réaction rapide !
La macro concerne le regroupement de plusieurs feuilles sur une autre.
Je ne sais pour quelle raison car tout fonctionne à merveille, mais parfois j'obtiens l'erreur suivante:
"Run-time error '9' et lorsque je lance le debug, la ligne 12, Col1 m'indique "For Elem = 0 To UBound(FileList)".

Est-ce cette erreur pourrait émaner de la db de mon client ?

Merci d'avance pour ton suivi.

Fabien

**Philippe Tulliez** · 17/06/2015, 14h15

Bonjour,
Dans cette contribution, il y a un tas de procédures publiée et je ne vois nulle part de ligne 12 ayant comme ligne de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Elem = 0 To UBound(FileList)

Il serait intéressant que tu publies la procédure que tu utilises et qui pose un problème.
Comme il s'agit d'une boucle qu'elle est la valeur de la variable FileList(Elem) au moment où l'erreur survient et que renvoie la fonction UBound(FileList) .

**Brainplosion** · 27/10/2015, 11h39

Bonjour,
Un petit reply pour vous remercier d'avoir publié cette Fonction extrêmement utile.
L'exemple est, de plus, bien utile pour appréhender les différentes options.
Pour ma part j'ai codé en dur la liste des fichiers car :
- j'ai la chance d'avoir une liste fixe
- les fichiers sont situés sur un SharePoint Foundation qui semble poser souci à la fonction GetFolder

Cordialement,
Johan

**Philippe Tulliez** · 27/10/2015, 12h52

Bonjour Johan,

Un petit reply pour vous remercier d'avoir publié cette Fonction extrêmement utile.
L'exemple est, de plus, bien utile pour appréhender les différentes options.

Merci pour votre retour.
Cela fait toujours plaisir de lire que ce que les contributions que l'on édite apporte de l'aide à d'autres.

Pour ma part j'ai codé en dur la liste des fichiers car :
- j'ai la chance d'avoir une liste fixe
- les fichiers sont situés sur un SharePoint Foundation qui semble poser souci à la fonction GetFolder

Je n'ai pas d'expérience avec SharePoint, je ne peux donc malheureusement pas apporter une réponse pertinente.

**ctsblv** · 14/02/2016, 19h22

Bonsoir
je suis en train de tester ta procédure qui est extra avec des fichiers *.xls.
Par contre je n'arrive pas à la faire marcher avec xlsx (access 2010).
J'ai un code retour 9 l'indice n'appartient pas à la sélection sur la ligne
For Elem = 0 To UBound(FileList) dans sub MainExport
du module mReadFolder.
Cette procédure peut-elle s'adapter à access 2010.
merci

**ctsblv** · 15/02/2016, 00h23

bonsoir
après plusieurs lectures de la procédure ,j'ai pu récuperer les xlsx.
Merci pour cette procédure super efficace.

**lacsaphumble2012** · 28/02/2017, 02h24

Envoyé par Philippe Tulliez

Bonjour,
Les trois procédures (MainExport, GetFolder, FileListInFolder) peuvent cohabiter ensemble dans un nouveau module mais peuvent aussi se placer dans le module où se trouve déjà la procédure ExportTable
Tu peux prendre un nouveau classeur avec une feuille dont le CodeName est shtExport.
Eventuellement avoir une feuille où tu places un bouton qui appelle la procédure MainExport qui est la procédure de démarrage et cela fonctionnera tout seul.
Il faut juste sélectionner le répertoire où se trouve les classeurs dont la première feuille contient la liste de données à exporter vers shtExport (toutes les feuilles doivent avoir le même nombre de colonne et avoir les étiquettes de colonnes la même orthographe).

Bonjour,
Voici un fichier exemple au format zip avec dans un répertoire nommé Excel - Export by AdvancedFilter un classeur nommé ExportWorkBookTable - Demo avec une une feuille dont le CodeName est shtExport et feuille [Menu] qui a un bouton qui permet de lancer la procédure MainExport
Ce répertoire contient un sous-répertoire nommé Mvt2003 qui contient quatre classeurs avec les feuilles à importer dans la feuille shtExport.
Il suffit donc de cliquer sur le bouton se trouvant dans la feuille [Menu] pour lancer la procédure, choisir le répertoire mvt2003 et cliquer sur OK.

Bonjour
après plusieurs recherches infructeuse je suis tombé sur ce post qui m'a beaucoup plu et je tiens à vous remercier une fois de plus merci.

**Philippe Tulliez** · 18/03/2017, 12h57

Bonjour lacsaphumble2012,
Merci d'avoir apprécié cette contribution.

**Benouche20** · 20/03/2017, 14h06

Super, un grand merci. Un gain de temps gigantesque pour une facilité déconcertante ! bien joué la macro.

Pour toujours viser la perfection : juste un petit point d'amélioration, cela ne doit pas être très dur pour les codeurs fous, une colonne supplémentaire dans le résultat avec le fichier source et le nom de la feuille

Regrouper plusieurs feuilles sur une autre. (2003-2010)

Contribuez

Discussions similaires

Partager

Partager