Regroupement automatique d'onglets dans un fichier Excel
Bonjour à tous,
Comment regrouper automatiquement les onglets d'un fichier Excel dans un seul onglet.
Ou bien comment à partir d'un fichier multi-onglets, génerer un fichier Excel avec un seul onglet.
Les onglets ayant bien sur le même format.
Le but etant de récupérer ensuite le fichier sur AS/400.
Merci d'avance si vous pouvez m'aider.
Hervé
Bonjour
Voici un code VBA qui devrait résoudre ton souci :
La macro crée au sein de ton classeur une feuille qui va réceptionner toutes les données présentes dans les autres feuilles.
Les explications sont notées avec des quotes
Places ce code dans un module VBA de ton classeur
J'ai intégré quelques lignes permettant selon le besoin de conserver les entetes de colonnes. Dans ton fichier d'exemple, les entetes n'étant pas présentes j'ai désactivé le code en plaçant des quotes devant les lignes.
CRDLT
Sub dplt()
'selection de la premiere feuille du classeur
Sheets(1).Select
'insertion d'une feuille qui se place en premier dans la classeur
Sheets.Add
'insertion d'un nom pour la feuille
ActiveSheet.Name = "Dest"
'====================================================================================
'cette partie du code sert à reporter le nom des entetes de colonne dans l'exemple
'ce code est inutile mais on peut l'activer en otant la cote en debut de ligne
'Sheets(2).Select
'Rows("1:1").Select
'Selection.Copy
'Sheets("Dest").Select
'ActiveSheet.Paste
'Range("A2").Select
'======================================================================================
'on compte le nombre de feuille dans le classeur
nb = Sheets.Count
'on lance une boucle qui va coler puis copier les donnees autant de fois qu'il y a de feuille
For i = 1 To nb - 1
'selection de la feuille (pourle prmier collage on prend la 2eme feuille
Sheets(i + 1).Select
'on positionne la cellule active
Range("A1").Select
'insertion d'une sécurité : on test si la celluelA 1 est remplie si elle ne l'est pas
'on considére que la feuille est vide on arrete la boucle
'si elle est remplie on effectue la boucle
If ActiveCell = "" Then
Sheets("Dest").Select
Exit For
Else
'==========================================================================
'on masque la premiere ligne pour ne pas reporter les entetes plusieurs fois dans le tableau de destination
'depend du choix effectué plus tôt
'Rows("1:1").Select
'Selection.EntireRow.Hidden = True
'Range("A2").Select
'==========================================================================
'on selectionne les donnees du tableau
Selection.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
'on les copie
Selection.Copy
'on reaffiche la ligne 1
Rows("1:1").Select
Selection.EntireRow.Hidden = False
'on selectionne la premiere feuille
Sheets("Dest").Select
'on colle
ActiveSheet.Paste
'on va positionner la cellule active à la fin du tableau
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
'on boucle
Next
'on se place en cellule A1 à l afin des collages succecifs
Range("A1").Select
End SubBonjour,
Place ce code en VBA (ALT + F11) dans un module.
Sub sauve()
'Macro par Dan pourhmoreau le 10/07
Dim i As Byte, lig As Long
Dim f
Sheets.Add After:=Sheets(Worksheets.Count)
With ActiveSheet
.Name = "dest"
End With
For f = 1 To Worksheets.Count
If Sheets(f).Name = "dest" Then End
lig = Sheets("dest").Range("a65536").End(xlUp).Row + 1
Sheets(f).UsedRange.Copy Destination:=Sheets("dest").Cells(lig, 1)
Next
End SubLe code te créera une nouvelle feuille et y placera toutes les données de tes onglets.
Pour exécuter le code, va dans Outils / Macros / macros, sélectionne la macro "Sauve" et clique sur le bouton "exécuter"
Amicalement
Dan