Regrouper plusieurs feuilles sur une autre

**GADENSEB** · 09/01/2015, 23h12

Bonsoir,

J'ai lu cette discussion.

Tout d'abord un grand merci à Philippe Tulliez pour ce superbe travail,
C'est pilpoil ce que je cherchais.

je l'adapte à mes besoins précis.

Par exemple, J'ai fais ciblé sur les fichiers *.xlsm avec

Code :

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

If Right(FileName, 5) = ".xlsm"

dans

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, 5) = ".xlsm" Then
   ReDim Preserve FileList(Elem): FileList(Elem) = FileName: Elem = Elem + 1
  End If
  FileName = Dir
 Loop
 FileListInFolder = FileList
End Function

--> Facile, je reconnais

En deuxième étape (j'ai plein d'idées) je voudrais intégrer le nom du fichier dans l'import (en colonne A) avec une variable "DebutNomFichier" dans un module

Code :

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

1
2
Option Explicit
Public DebutNomFichier

Pour Mvt-Fev.xlsm ->

Code :

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

DebutNomFichier= Mvt-Fev

du coup, je tente cela

Code :

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

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

mais j'ai une erreur de compilation sur :

Code :

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

FileList = FileListInFolder(Folder)

dans

Code :

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

Sub MainExport()

Le volet espion me renvoie "impossible de compiler le module" sur FileListInFolder

Chose que je comprends pas car je défini juste une valeur....
J'ai du louper un truc.....

Je pense qu'il faut aussi rajouter dans le code :

Code :

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

1
2
3
Function ExportTable
--------------------------------------------------
.Copy TargetSheet.Range("a" & TargetRow & DebutNomFichier) ' Copie de plage

Cela te semble correct ?

Ps : L'étape 2 sera l'import des fichiers dans des sous-répertoires et non plus un un seul répertoire .... je bosse déjà là-dessus !!!!

Bonne soirée à Tous et au Forum

**Philippe Tulliez** · 10/01/2015, 08h23

Bonjour,

Tout d'abord un grand merci à Philippe Tulliez pour ce superbe travail,
C'est pilpoil ce que je cherchais.

Merci pour ton appréciation

Pas le temps pour l'instant de vérifier l'ensemble de ce que tu as écrit mais à la première lecture rapide, je constate déjà un petit soucis ici

Code :

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

DebutNomFichier= "Mvt-Fev"

Il manque les guillemets

**GADENSEB** · 14/01/2015, 11h56

Salut,

Désolé je répond en décalage,

DebutNomFichier= Mvt-Fev était un exemple.
Je souhaite reprendre le nom du fichier, puis l'insérer en colonne A au moment du rapatriement de toutes les données.

Du coup, est-ce que ma démarche est correcte en tt cas cela ne fonctionne pas ....

**Philippe Tulliez** · 14/01/2015, 17h27

Bonjour,
Je ne saisi pas bien ce que tu cherches à faire.
La fonction nommée ExportTable a pour but de regrouper des tableaux ou listes de même nature (nombre de colonnes identiques ainsi que l'orthographe de ce étiquettes) éparpillées sur des feuilles du même classeur ou de classeurs différents. Il suffit de lui passer les bons arguments donc je ne comprends absolument pas ce que signifie ta suggestion.

Code :

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

.Copy TargetSheet.Range("a" & TargetRow & DebutNomFichier) ' Copie de plage

Il faudrait être plus clair et expliquer ce qui ne fonctionne pas (Y a t'il un message d'erreur ?) et ce que tu veux faire. C'est difficile de décortiquer des dizaines de lignes de code écrit pas quelqu'un d'autres sans vraiment connaître ce qu'il veut faire.
Je ne comprends pas pourquoi tu veux insérer en colonne A le nom du fichier, l'import ne fonctionnera pas

**GADENSEB** · 14/01/2015, 18h46

Bonsoir,

Tu as raison, je ne me suis peut être pas bien exprimé, mea-culpa !

Le but du jeu est d'insérer le nom du fichier dans une premiére colonne A puis d'insérer les données rapatrier par ExportTable à partir de la colonne B

Le but étant ensuite de pourvoir faire des analyses (TCD...) avec la colonne A (nom fichier).

du coup, je me dis qu'il faut instituer une variable "DebutNomFichier"

---> Est-ce plus clair du coup ?

(toute variante est possible)

Quand tu dis "éparpillées sur des feuilles", si je comprends bien on peut récupérer sur plusieurs onglets de chaque fichier ????
Pour infos, mes futurs fichiers seront : "Janvier, Février, Mars......Jusqu’à Décembre"

En relisant le code, je ne vois pas quelle variable fait cela !!!

très très interessant !

J'ai un plantage sur :

Code :

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

.Copy TargetSheet.Range("a" & TargetRow & DebutNomFichier) ' Copie de plage

Il me dit que c'est nom définie, ce qui se comprends car la variable "DebutNomFichier" n'est pas forcement bien placée.

Merki !

**GADENSEB** · 18/01/2015, 20h43

Hello
Je suis entrain de fouiller ton code !

Je comprends qu'il importe uniquement le premier onglet de chaque fichier et je cherche à sortir tous les onglets !

Du coup je me dis qu'il faut créer un compteur

Code :

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

1
2
3
4
5
 Dim Sourcesheet As Worksheet
------
For Each Sourcesheet In TargetSheet.Worksheet
-----
 Next Sourcesheet

Il me pose une "Méthode introuvable sur ".Worksheet"
Volet espion (Impossible de compiler le module sur Sourcesheet "

Cela te parait cohérent ?

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
83
84
85
86
87
88
89
90
 Option Explicit
Option Private Module
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  : 09/01/2013 (02/01/2013)
 ' Version 1.2
 ' Update
 ' 02/01/2013-1.0 - Version Beta
 ' 08/01/2013-1.1 - Mise en production
 ' 09/01/2013-1.2 - Liberé les variables objets
 ' 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 Sourcesheet As Worksheet
 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
 '
 For Each Sourcesheet In TargetSheet.Worksheet
 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("A2").CurrentRegion
 Set rngImport = FromSheet.Range("A2").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 '& DebutNomFichier
          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 -> Pas de copie
          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
     End Select
    End With
 End Select
   Next Sourcesheet
 Set rngTarget = Nothing: Set rngImport = Nothing: Set LabelTarget = Nothing: Set LabelImport = Nothing
 TargetSheet.Cells.EntireColumn.AutoFit
End Function

**Philippe Tulliez** · 19/01/2015, 08h47

Bonjour,

Je suis entrain de fouiller ton code !
Je comprends qu'il importe uniquement le premier onglet de chaque fichier et je cherche à sortir tous les onglets !
Du coup je me dis qu'il faut créer un compteur

Plutôt que de modifier la procédure elle-même, il faut prévoir une boucle qui l'invoque.
C'est d'ailleurs ce qui se passe dans le classeur exemple téléchargeable se trouvant dans le premier post de cette contribution.
La procédure (Sub) se nomme ExportSheetSelectedToExportSheet et est présente dans le module nommé mExportTest. Cette procédure est elle-même invoquée par la procédure événementielle cmdOk_Click présente dans le formulaire (UserForm) nommé usfSelectSheet

**Philippe Tulliez** · 19/01/2015, 09h06

Bonjour,
Si l'on reprend un petit exemple sur ce même classeur avec la procédure ci-dessous. Exportation de toutes feuilles dont les trois premières lettre du nom est "mvt" vers la feuille nommée [Export]

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
 Dim sht As Worksheet, shtTarget As Worksheet, count As Integer
 Set shtTarget = ThisWorkbook.Worksheets("Export")
 For Each sht In ThisWorkbook.Worksheets
  If LCase(Left(sht.Name, 3)) = "mvt" Then
   count = count + 1
   ExportTable sht, shtTarget, ClearSheet:=(count = 1)
  End If
 Next
End Sub

**GADENSEB** · 19/01/2015, 17h11

Ok je viens de tester !

cela marche nikel
cependant je me suis apercu que les majuscules ne marchent pas dans

Code :

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

 If LCase(Left(sht.Name, 3)) = "mvt" Then

Par exemple si on ecrit "MVT" la procédure ne se déclenche pas.

Si dans le code "mvt" et "MVT" dans le nom des onglets cela marche par contre ....

tu crois que c normal ?

**Philippe Tulliez** · 19/01/2015, 17h30

Bonjour,
Dans le monde Microsoft on ne fait pas de distinction entre les majuscules et minuscules pour les noms de fichiers, de variables, de modules, etc.
Une variable nommée TOTO, Toto, ToTo, etc. c'est du pareil au même.
Par contre les tests logiques font cette distinction et heureusement d'ailleurs.
C'est la raison pour laquelle, j'utilise la fonction LCase qui transforme en minuscule le nom du fichier pour éviter justement de passer à côté de casses différentes dans le nom des fichiers.
Donc dans notre exemple les trois premières lettres du nom des fichiers peuvent être MVT, mvt, Mvt, mVT, etc. c'est transparent.
J'ajoute que d'habitude j'utilise systématiquement l'imbrication des fonctions Trim et Lcase, ex : Trim(Lcase(Variable)), ainsi j'évite les problèmes d'espaces avant et après le nom.

**GADENSEB** · 20/01/2015, 08h58

Hello !

J'ai appris qqc today !!!
Merci !!! Je m'en resservirais plus tard certainement !
Du coup, c'est cette boucle (en l'adaptant) que je dois inclure dans "ExportTable"

Ok !!! je m'y met à midi !!

Thanks

**GADENSEB** · 25/01/2015, 17h23

Salut !

mmmmm J'ai pris un peu de temps pour répondre
J'avoue que je ne pas ou placer la boucle pour qu'au mon du lancement de la procédure d'import le code recherche et boucle sur tous les onglets

Est-ce que tu aurais un indice pour moi, stp ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TousOnglets_click()
 Dim sht As Worksheet, shtTarget As Worksheet, count As Integer
 Set shtTarget = ThisWorkbook.Worksheets("Export")
 
 
 
 For Each sht In ThisWorkbook.Worksheets
  If LCase(Left(sht.Name, 3)) = "mvt" Then
   count = count + 1
   ExportTable sht, shtTarget, ClearSheet:=(count = 1)
  End If
 Next
End Sub

**Philippe Tulliez** · 25/01/2015, 17h34

Bonjour,
Dans la boucle ci-dessous on parcourt toutes les feuilles de calcul du classeur où se trouve le code VBA (ThisWorkbook) et on ne traite que les feuilles préfixées mvt peut importe la casse (If LCase(Left(sht.Name, 3)) = "mvt" Then...).

Code :

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

1
2
3
4
5
6
For Each sht In ThisWorkbook.Worksheets
  If LCase(Left(sht.Name, 3)) = "mvt" Then
   count = count + 1
   ExportTable sht, shtTarget, ClearSheet:=(count = 1)
  End If
Next

Donc si tu traites plusieurs classeurs dont tu dois traiter toutes les feuilles, il faut remplacer l'objet ThisWorkbook par Workbooks("LeNomDuClasseur") ou par une variable objet type Workbook

**clementmarcotte** · 25/01/2015, 21h47

Bonjour Philippe,

Envoyé par Philippe Tulliez

Bonjour,
Dans le monde Microsoft on ne fait pas de distinction entre les majuscules et minuscules pour les noms de fichiers, de variables, de modules, etc.
Une variable nommée TOTO, Toto, ToTo, etc. c'est du pareil au même.

Ce n'est pas pour ergoter, mais je me permets, une petite précision, au cas où. Tout d'abord, tu as parfaitement raison, en ce qui concerne le BASIC; que ce soit VB6, VBA ou VB.net il n'est pas "Case Sensitive", comme disent les Américains.

Par contre, C# est "Case Sensitive", et là, Microsoft respecte la casse; et Arthur est vraiment différent de arThur ou de arthur.

**Philippe Tulliez** · 25/01/2015, 22h01

Bonjour Clément,
Merci de cette précision car ne connaissant pas le c#, j'ai sans doute lancé une affirmation erronée.

**GADENSEB** · 29/01/2015, 09h54

Salut,
Je reviens vers toi aprés un temps de décalage
je n'ais pas le fichier à dispo, mais je tente de résonner ....

Cela te semble correct ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub TousOnglets_tousFichiers_click()
 Dim sht As Workbooks, shtTarget As Workbooks, count As Integer
 Dim WKBS As Workbooks
 
 'Récupéré le nom du fichier dans la macro mReadFolder
 Set shtTarget = WKBS.Workbooks
 
  For Each sht In WKBS.Workbooks
  If LCase(Left(sht.Name, 3)) = "mvt" Then
   count = count + 1
   ExportTable sht, shtTarget, ClearSheet:=(count = 1)
  End If
 Next
End Sub

**Philippe Tulliez** · 29/01/2015, 10h19

Bonjour,
Une chose essentielle à savoir.
La procédure que j'ai écrite regroupe une plage de données contenue dans une feuille sur une autre. Il y a des arguments obligatoires et d'autres facultatifs qui ont une valeur par défaut. La contrainte est que le nombre de colonnes et l'orthographe des étiquettes de colonnes doivent être identiques.
Un point c'est tout.
Tu peux donc invoquer cette procédure pour copier une feuille sur une autre existante ou pas ou en copier plusieurs mais cela n'a plus rien avoir avec la procédure.
A toi de prévoir une boucle qui parcourt toutes les feuilles d'un classeur avec ou pas une structure conditionnelle qui va sélectionner certaines feuilles plutôt que d'autres ou parcourir un répertoire pour ouvrir un ou plusieurs classeurs dont tu prendras une ou plusieurs feuilles mais cela c'est un travail à faire en amont de l'appel à la procédure.
Le classeur que j'ai mis en exemple en début de discussion propose plusieurs feuilles sur le même classeur et un autre fichier plus bas (Post #5) au format zip contenant un classeur dans lequel on regroupe plusieurs feuilles provenant de quatre classeurs se trouvant dans un sous-répertoire.
Donc pour bien utiliser la procédure, je te propose de relire l'explication faite dans le premier post ici avec le classeur exemple à télécharger. Il me semble mais je peux me tromper que c'est suffisamment complet.
Ce premier fil a donc pour exemple, un regroupement de plusieurs feuilles (au choix de l'utilisateur avec un formulaire) du même classeur.
Suite à une question

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)?

J'ai montré un exemple dans le post #3 avec un fichier au format zip dans le post #5 qui permet de faire un test;

Donc tout cela pour dire que dans les post de cette contribution, je peux recevoir des remarques positives ou négatives concernant la procédure que j'ai écrite, recevoir des suggestions qui si je les trouve intéressante et en adéquation avec mon projet initial, j'en tiendrai compte dans une version ultérieure que je publierai ici, mais je ne peux pas répondre sur des procédures à écrire qui appellent la mienne. Le forum est là pour cela et d'autres intervenants peuvent y répondre.

Regrouper plusieurs feuilles sur une autre

Macros et VBA Excel

Discussions similaires

Partager

Partager