Macro pour diviser le contenu d'une feuille en plusieurs onglets

Le 15/08/2019 à 12:44

Bonjour à tous,

Je cherche à découper une feuille d'un fichier Excel en plusieurs onglets avec comme critère la colonne A.

La feuille principale contient des colonnes de "A" à "Z", je souhaite faire un filtre sur la colonne "A", copier la sélection, ajouter une feuille, coller le résultat en ligne A11 et ainsi de suite pour tous les éléments de la colonne "A".

J'ai créé un onglet que j'ai appelé "table" avec tous les éléments de la colonne "A" en définissant un "nom" = Table.

Voici ce que j'ai tenté :

Sub Macro1()

'

For Each classeur In Range("Table")

'Range("A1").Select

Selection.AutoFilter Field:=1, Criteria1:=classeur

Range("A1:Z200000").Select

'Range("A1").Activate

Selection.Copy

Sheets.Add After:=ActiveSheet

Range("A11").Select

ActiveSheet.Paste

Sheets("Feuil1").Name = ("a")

Range("A11").Select

ActiveSheet.ShowAllData

Next classeur

End Sub

Je rencontre 2 problèmes :

- la macro s'arrête dès la première feuille créée. Il me semble avoir compris que cela venait de "

ActiveSheet.ShowAllData". Si je l'enlève, la nouvelle feuille a un filtre que je souhaiterai enlever.

- J'ai voulu renommer les onglets plutôt que d'avoir "Feuil1", "Feuil2". J'ai tenté une approche mais cela va m'obliger et écrire un à un. y a t-il une méthode plus simple ? Est-ce envisageable que le nom de la feuille soit celui du nom de la "Table" ?

Merci beaucoup pour votre écoute et vos conseils.

Le 15/08/2019 à 12:48

Bonjour,

Ta demande est très très fréquente ...

A titre d'exemple ... pour ton inspiration ...et exploser ton fichier

https://forum.excel-pratique.com/viewtopic.php?p=761283#p761283

En espèrant que cela t'aide

Edit: Salut Thauthème

Le 15/08/2019 à 14:12

Bonjour le fil, bonjour le forum,

Pas sûr que ce soit plus rapide que la proposition de James (j'aurais même plutôt tendance à penser le contraire), mais voici une autre proposition qui n'utilise pas de filtres mais des variables tableau :

Sub Macro1()
Dim OP As Worksheet 'déclare la variable OP (Onglet Principal)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim OC As Worksheet 'déclare la variable OC (Onglet Créé)

Set OP = Worksheets("Feuil1") 'définit l'onglet OP (à adapter à ton cas)
TV = OP.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments de D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    Erase TL: K = 1 'vide le tableau TL, initialise la variable K
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si la donnée ligne I colonne 1 de la boucle 2 correspond à l'élément TMP(J) de la boucle 1
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes de TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
    Set OC = ActiveSheet 'définit l'onglet crée OC
    OC.Name = TMP(J) 'renomme l'onglet
    OC.Range("A1").Resize(1, NC) = Application.Index(TV, 1) 'renvoie la ligne de titres dans A1 redimensionné
    OC.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans A2 redimensionnée
Next J 'prochain élément de la boucle 1
End Sub
Le 15/08/2019 à 15:14

bonjour à tous

suggestion alternative : ne rien "copier", ne pas "éclater" les données. Simplement les afficher dans des onglets en plus

on conserve intégralement l'onglet de départ

mettre un TCD dans un onglet et le filtrer pour voir uniquement ce qu'on veut

mettre un TCD identique dans un autre onglet et le filtrer autrement

autre solution (100 fois plus facile que VBA) créer 2 requêtes Power Query

voir TCD sur même feuille que saisie

et PQuery sur l'autre feuille

amitiés à tous

324classeur4.xlsx (23.12 Ko)
Le 15/08/2019 à 15:16

Bonjour à tous,

Je vous remercie pour le temps que vous m'avez accordé ainsi que vos solutions.

J'ai enfin réussi grâce à vous et suis très reconnaissante.

Merci encore à vous,

Cordialement,

Mélanie

Le 15/08/2019 à 15:41

Content que tout fonctionne ...

Merci pour tes remerciements

Rechercher des sujets similaires à "macro diviser contenu feuille onglets"