Scinder feuille en classeur

[Guitl]

Bonjour,

j'ai un fichier avec des colonnes regroupant des salariés par manager, direction et service.

Je souhaite, à partir de cette feuille créer autant de fichier que de managers présents.

Ainsi par exemple pour le fichier ci joint, je devrai au final avoir 3 classeurs : pour le manager AF 8 lignes.

Enfin, la macro enregistrerai automatiquement le nom du classeur en reprenant les éléments "campagne EP + cellule B1 + nom du manager".

Merci d'avance !

Cdl

Guitl

 

[JCGL]

Re : Scinder feuille en classeur

Bonjour à tous,

Un essai avec un joli code mDF .

A adapter (je n'ai pas compris ton Campagne EP + cellule B1)

A+

Edition : Salut Eric

 

[RENAUDER]

Re : Scinder feuille en classeur

Bonjour,

Voici une version différente de JCGL.
Comme dirait l'autre, à chacun son code n'est-ce pas JCGL.

Salutations JCGL

 

[Staple1600]

Re : Scinder feuille en classeur

Bonjour à tous



Avec un code glané sur le net

Sub DistributeRowsToNewWBS()
'auteur Norie
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
    
    Set wsData = Worksheets("Feuil1") ' name of worksheet with the data
    Set wsCrit = Worksheets.Add
    
    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
    
    ' column H has the criteria
    wsData.Range("G1:G" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("H1"), Unique:=True
    
    Set rngCrit = wsCrit.Range("H2")
    While rngCrit.Value <> ""
        Set wsNew = Worksheets.Add
        ' change E to reflect columns to copy
        wsData.Range("A1:G" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
        wsNew.Name = rngCrit
        wsNew.Copy
        Set wbNew = ActiveWorkbook
        ' saves new workbook in path of existing workbook
        wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit & ".xls"
        wbNew.Close SaveChanges:=True
        Application.DisplayAlerts = False
        wsNew.Delete
        rngCrit.EntireRow.Delete
        Set rngCrit = wsCrit.Range("H2")
    Wend
    
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[Guitl]

Re : Scinder feuille en classeur

Merci merci !!!

je devrai m'en sortir. Mon objectif va d'être de comprendre les codes et de les adapter à mon classeur final, mais ca devrait marcher...

Merci de votre réactivité !

 

[Guitl]

Re : Scinder feuille en classeur

Yop !

merci pour le travail, j'ai adapté le code de RENAUDER, plus facile à comprendre pour moi...

Seul petit bug, est que j'ai des listes de validation et qu'il ne me le prend pas dans les fichier crées.

Ci joint mon fichier avec le nouveau code, et en colonne AB AC AD ma liste de validation (je sais je n'avais pas mis cette contrainte dans le premier exemple...)

Merci d'avance !

Ci joint le fichier avec colonne définitive...

Guitl

 

[RENAUDER]

Re : Scinder feuille en classeur

Bonjour,
Elles te servent à quoi tes Listes de validation, je ne vois nulle part de la colonne A à N, des listes de choix ?

 

[Guitl]

Re : Scinder feuille en classeur

Ben si... normalement dans les cellulles en grisé (mise en forme conditionnelle) en
colonne K correspond la liste de choix "obj" avec 4 possibilités
colonne L correspond liste de choix "cpt" avec 3 poss
colonne M correspond liste de choix "cont" avec 4 poss.

 

[RENAUDER]

Re : Scinder feuille en classeur

Bonjour,

Voici le nouveau classeur modifié.
J'ai du rajouter du code car il gardait les liaisons avec le classeur source.

 

[Guitl]

Re : Scinder feuille en classeur

Merci,

c'est parfait !

Guitl