Le regroupement de plusieurs feuilles sur une autre est une question récurrente dans les forums Excel.
Voici 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 si l’argument ClearSheet est à True.
Les arguments
FromSheet : Feuille d’où viennent les données
TargetSheet : Feuille cible
[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).
[CountOfLine] : Byte, Nombre de ligne de titre, 1 par défaut
La syntaxe
Deux syntaxes possibles, soit en renvoyant une valeur (Function)
nbRow = ExportTable(WS, shtExport, ClearSheet:=False, ValueOnly:=True, ShowMsg:=False, CountOfLine:=2)
Soit comme méthode
ExportTable WS, shtExport, ClearSheet:=False, ValueOnly:=True, ShowMsg:=False, CountOfLine:=2
Où WS est une variable objet de type WorkSheet et shtExport est le CodeName de la feuille cible.
Le code de la procédure
Function ExportTable(DataSource As Object, TargetSheet As Worksheet, _ Optional ValueOnly As Boolean = False, _ Optional ClearSheet As Boolean = False, _ Optional ShowMsg As Boolean = True, _ Optional CountOfLine As Byte = 1) 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 : 27/02/2014 (1st vers 02/01/2013) ' Version 3.1 ' 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 ' 12/07/2013-2.1 - Changer l'argument FromSheet(WorkSheet) en DataSource (Object) ' 27/02/2014-3.1 - Ajouté argument CountOfLine ' 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 ' [CountOfLine]- Byte [d:=1] Nombre de ligne de titre ' *** Déclaration *** ' ... Variables messages d'erreurs Const ver As String = "V 3.1" Const ErrTitle As String = "Procédure - ExportTable" Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf ' Dim c As Integer Dim rngTarget As Range, rngSource As Range, FromSheet As Worksheet Dim LabelTarget As Range, LabelImport As Range Dim TargetRow As Long, depl As Integer Dim AddressNew As String On Error GoTo ErrorHandle Select Case True ' Test 1er argument Case TypeOf DataSource Is Worksheet: Set rngSource = DataSource.Range("A1") Case TypeOf DataSource Is Range: Set rngSource = DataSource Case Else: Error 10001 ' Goto Gestionnaire d'erreur End Select ' If rngSource.Worksheet.Name = TargetSheet.Name Then Exit Function ' Sortie de procédure Set FromSheet = rngSource.Worksheet ' If ClearSheet And TargetSheet.Range("A1").CurrentRegion.count <> 1 Then TargetSheet.Cells.Clear ' *** Assignation *** Set rngTarget = TargetSheet.Range("A1").CurrentRegion Set rngSource = FromSheet.Range("A1").CurrentRegion ' ... Ligne titre (Labels) Set LabelTarget = rngTarget.Resize(1, rngTarget.Columns.count) Set LabelImport = rngSource.Resize(1, rngSource.Columns.count) With rngTarget: TargetRow = .Rows.count + Abs(.Rows.count > 1): End With With TargetSheet AddressNew = .Range(.Cells(TargetRow, 1), .Cells(TargetRow + rngSource.Rows.count - 1, rngSource.Columns.count)).Address End With ' *** Start *** Select Case rngSource.Rows.count Case Is > 1 depl = Abs((TargetRow > 1)) Set rngSource = rngSource.Offset(depl * CountOfLine).Resize(rngSource.Rows.count - (depl * CountOfLine)) With rngSource 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 = rngSource.Rows.count Case LabelTarget.count = .Offset(CountOfLine - 1).Resize(1, .Columns.count).count ' 14/02/27 Modif ' ' Vérification si même nombre de colonne et sortie de fonction For c = 1 To LabelTarget.Columns.count If Trim(UCase(LabelTarget.Cells(CountOfLine, c))) <> Trim(UCase(LabelImport.Cells(CountOfLine, 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 + rngSource.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 TargetSheet.Cells.EntireColumn.AutoFit Set rngTarget = Nothing: Set rngSource = Nothing: Set LabelTarget = Nothing: Set LabelImport = Nothing Exit Function ' Fin de procédure ' Gestionnaire d'erreurs ErrorHandle: Select Case Err Case 10001: Err.Description = "Variable Objet (DataSource) mal définie (WorkSheet) ou (Range)" End Select MsgBox ErrMsg & Err.Description, vbCritical, Title:=ErrTitle On Error GoTo 0 Set rngTarget = Nothing: Set rngSource = Nothing: Set LabelTarget = Nothing: Set LabelImport = Nothing End Function
Classeur exemple à télécharger
[wpdm_package id=’641′]
Le classeur de démonstration 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
Bonjour,
Merci beaucoup pour votre macro.
J’ai une petite question, si par exemple on dispose de 2 lignes de titres et non pas une seule, quelle bout de code faut il modifier pour ne pas recopier ces 2 lignes?
Modification apportée à la fonction en ajoutant un argument facultatif.
Bonjour,
Merci pour votre appréciation.
Les deux lignes de titres sont-elles présentes dans les feuilles importées (argument FromSheet) ou dans la feuille cible (argument TargetSheet) ?
Bonjour,
Les deux lignes de titres sont présentes dans les feuilles importées (sont les mêmes partout) et justement j’aimerais les conserver dans la feuille cible (Feuille Export), sans qu’elles soient répétées lors du regroupement. En gros, qu’elles restent en titres dans la feuille Export.
Bonjour,
J’ai ajouté un argument optionnel nommé CountOfLine à la procédure afin de pouvoir indiquer le nombre de ligne de titre qu’il y a. La valeur par défaut est 1.
J’ai publié la nouvelle version (2.1). Le classeur exemple suivra dans 1 ou 2 jours.
La vérification de l’exactitude des étiquettes de colonnes n’est faites que sur la dernière ligne des titres (la deuxième si les titres font deux lignes).
Merci beaucoup!
Bonjour,
Je suis novice dans le vba.
La fonction exportTable me pose problème. J’ai bien L’option valueonly = true pour exporter la valeur de la cellule au lieu de la formule.
Malgré cela, lors de l’export, la copie est celle de la formule. (par exemple, il m’exporte =3+1 à la place de la 4).
Pourriez vous m’aider à comprendre ce qu’il ne fonctionne pas.
D’avance merci.
JULIEN
Rectification de mon précédent message. La copie de valeur fonctionne lors qu’il y a un calcul. exemple : =3+1
Par contre :
Une cellule de mon onglet source fait référence a une autre cellule du même onglet (=+$AC$2).
La copie vers mon onglet Cible ne copie pas la valeur de l’onglet source, mais fait référence a la cellule =+$AC$2 de mon onglet cible.(pas de copie de valeur).
Il copie la valeur de mon onglet cible au lieu de l’onglet source.
Pourriez vous m’aider?
D’avance merci.
JULIEN
Dernier commentaire pour dire que c’est une erreur de débutant.
Il suffit de préciser le nom de l’onglet source dans la formule…
Ne prendre en comptes mes remarques.
Encore merci pour le code.
JULIEN
Bonjour,
Super votre travail, cependant cela fonctionne que avec du xls. comment faire pour que cela fonctionne avec du xlsx?
Merci d’avance.
Bonjour,
débutante en VBA excel et n’ayant que de très légères notions « informatique », je voulais juste vous dire un grand merci pour vos macros et leur explication qui me permettent d’apprendre tout en améliorant considérablement mon travail au quotidien.
J’ai ainsi pu automatiser un certain nombre de tâches qui jusqu’ici me prenaient des heures…. Alors juste un grand MERCI !!!!
Bonjour Isabelle,
Merci pour votre retour qui fait extrêmement plaisir
Philippe