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