Diviser un classeu en plusieurs en se basant sur les noms des feuilles

Le 18/12/2018 à 09:11

Bonjour cher Forum

De nouveau, je me permets de s'adresser aux experts de ce forum qui m'ont toujours aidé à trouver des solutions géniales

En fait, j'ai un classeur qui contient plusieurs feuilles (le nombre est variable), le libellé des feuilles contient une clé (voir feuille "Liste", colonne B), donc mon besoin est de pouvoir diviser mon classeur principal en plusieurs classeurs selon cette clé de regroupement ç.à.d. si j'ai 5 clés par exemple j'aurai 5 classeurs nommés avec la libellé de la clé et contenant chacun uniquement les feuilles contenant cette clé...

Pour plus de détails, veuillez trouver ci-joint un exemple de mon classeur avec quelques feuilles

PS: chaque feuille contient des formules de calcul, donc si possible de transformer toutes les formules en valeurs lors de l'opération de découpage

D'avance, merci pour votre temps et l'aide que vous pouvez m'apporter

10diviser-classeur.xlsx (16.98 Ko)
Le 18/12/2018 à 11:26

bonjour

à quoi sert de multiplier les fichiers ?

est-ce que tous les onglets ont la même forme (seules les données varient d'un onglet à l'autre) ?

ça fait 2 questions

à te relire

amitiés excelliennes

Le 18/12/2018 à 11:37

Bonjour JMD et merci pour votre intérêt à mon problème,

Pour répondre à vos questions :

à quoi sert de multiplier les fichiers ? ==> En fait les fichiers seront envoyer à plusieurs destinateurs qui ne doivent pas voir les données des autres et la détermination du destinateur se fait par la clé d'identification (un destinateur peut avoir une seule feuille dans son classeur tandis qu'un autre peut avoir 10 feuilles)

est-ce que tous les onglets ont la même forme (seules les données varient d'un onglet à l'autre) ? ==> Pas forcément, certes il y a quelques feuilles qui se ressemblent en terme de format mais il y a d'autres qui sont personnalisés en fonction du destinataire

J'espère que j'ai répondu à vos questions et que cela vous aide à mieux comprendre mon besoin.

PS: J'ai une macro simple qui liste les noms des feuilles dans l'onglet liste dans la colonne A ensuite j'extrais la clé via une formule dans la colonne B

merci d'avance

Le 19/12/2018 à 10:14

Bonjour tout le monde,

Est ce que quelqu'un peut m'aider svp ou me donner une piste please

C'est très bloquant pour mon avancement et le fait de le faire manuellement est très fatigant

Help Please

Le 19/12/2018 à 19:42

Bonsoir à tous,

Vois ceci :

Option Explicit
Sub test()
Dim i As Long, t As Byte, e, s, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    With Sheets("Liste").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dico.exists(.Cells(i, 2).Value) Then
                Set dico(.Cells(i, 2).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 2).Value).CompareMode = 1
            End If
            Set dico(.Cells(i, 2).Value)(.Cells(i, 1).Value) = _
            Sheets(.Cells(i, 1).Value).Cells(1).CurrentRegion
        Next
    End With
    For Each e In dico
        t = 0
        With Workbooks.Add
            For Each s In dico(e)
                t = t + 1
                If t > .Sheets.Count Then
                    Sheets.Add After:=.Sheets(.Sheets.Count)
                End If
                With .Sheets(t)
                    dico(e)(s).Copy .Cells(1)
                    .Name = s
                End With
            Next
            .SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
            .Close False
        End With
    Next
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set dico = Nothing
End Sub

klin89

Le 20/12/2018 à 09:05

Bonjour Klin89,

Meeeeeeeeeeeeeeeeeeeeeeeeeeeeerci beaucoup pour votre proposition

ça l'air de bien fonctionner sur mon exemple, je vais la tester sur mo fichier réel

BRAVO

je vous souhaite une très bonne journée

Le 20/12/2018 à 10:34

Bonjour Klin89,

de nouveau, je vous remercie pour votre temps et votre intérêt à mon problème

en testant la macro sur un fichier réel, elle fonctionne à merveille mais les feuilles crées dans les nouveaux classeurs sont toujours vides

Est-il possible de revoir ce point de telle sorte que les feuilles gardent tout le contenu et remplacer les formules par des valeurs (Collage valeurs) ?

ça sera très génial si vous arrivez à me faire cette modification svp

Merci d'avance

Le 20/12/2018 à 21:27

re Morino,

Remplace ceci :

With .Sheets(t)
    dico(e)(s).Copy .Cells(1)
    .Name = s
End With

par cela :

With .Sheets(t)
    dico(e)(s).Copy
    .Cells(1).PasteSpecial xlPasteValues
    .Name = s
End With

L'instruction ci-dessous signifie que tu crées une clé dans le dictionnaire enfant en lui affectant un objet range

Set dico(.Cells(i, 2).Value)(.Cells(i, 1).Value) = _
            Sheets(.Cells(i, 1).Value).Cells(1).CurrentRegion

Exemple :

Set dico("123456789")("AAA_123456789") = _
            Sheets("AAA_123456789").Cells(1).CurrentRegion

Une fois le dictionnaire alimenté, place un point d'arrêt, puis dans la fenêtre espion, regarde ce que renvoie :

dico("123456789")("AAA_123456789").Value

et tu comprendras ce qui cloche

klin89

Le 21/12/2018 à 15:06

Bonjour klin89,

De nouveau je vous remercie pour votre temps et votre intérêt à mon sujet

j'ai passé un bon moment à essayer à comprendre le problème mais sans succès malheureusement, cependant lorsque j'ai fait une petite modification dans le code j'arrive à avoir des classeurs par clé avec uniquement le contenu de la 1ère feuille, et les autres feuilles vides

Voici le code légèrement modifié :

Option Explicit
Sub test()
Dim i As Long, t As Byte, e, s, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Sheets("Liste").Select
    With Sheets("Liste").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dico.exists(.Cells(i, 2).Value) Then
                Set dico(.Cells(i, 2).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 2).Value).CompareMode = 1
            End If
            Set dico(.Cells(i, 2).Value)(.Cells(i, 1).Value) = _
            Sheets(.Cells(i, 1).Value).Cells
        Next
    End With
    For Each e In dico
        t = 0
        With Workbooks.Add
            For Each s In dico(e)
                t = t + 1
                If t > .Sheets.Count Then
                    Sheets.Add After:=.Sheets(.Sheets.Count)
                End If
                    With .Sheets(t)
                        dico(e)(s).Copy
                        Cells.PasteSpecial xlPasteValues
                        .Name = s
                    End With
            Next

            .SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
            .Close False
        End With
    Next
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

je sens qu'on est prêt du résultat escompté et qu'il suffit de faire une petite modification mais je n'arrive pas à la trouver malgré toutes mes tentatives

d'avance, merci

Le 21/12/2018 à 21:00

re Morino,

La propriété CurrentRegion est l'équivalent du raccourci clavier manuel Ctrl + *

Dans ton cas, place toi en A1 dans chacune de tes feuilles, appuie sur Ctrl + * pour voir la plage ainsi sélectionnée.

---------> Sheets(.Cells(i, 1).Value).Cells(1).CurrentRegion

klin89

Le 22/12/2018 à 18:05

re Morino,

En fait, tu veux affecter un objet Worksheet aux clés du dictionnaire enfant

Vois les modifications :

Option Explicit
Sub test()
Dim i As Long, t As Byte, e, s, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    With Sheets("Liste").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dico.exists(.Cells(i, 2).Value) Then
                Set dico(.Cells(i, 2).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 2).Value).CompareMode = 1
            End If
            Set dico(.Cells(i, 2).Value)(.Cells(i, 1).Value) = Sheets(.Cells(i, 1).Value)
        Next
    End With
    For Each e In dico
        t = 0
        With Workbooks.Add
            For Each s In dico(e)
                t = t + 1
                If t > .Sheets.Count Then
                    Sheets.Add After:=.Sheets(.Sheets.Count)
                End If
                With .Sheets(t)
                    dico(e)(s).Cells.Copy     '<-------- la modif
                    With .Cells(1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlFormats
                    End With
                    .Name = s
                End With
            Next
            .SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
            .Close False
        End With
    Next
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set dico = Nothing
End Sub

klin89

Rechercher des sujets similaires à "diviser classeu basant noms feuilles"