Diviser un classeu en plusieurs en se basant sur les noms des feuilles
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
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
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
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
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
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
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
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
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
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
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