création de classeur (ou d'onglet) à partir des critères contenus dans une colonne

Le
robocor
Bonjour à tous,

Voici mon problème :
Je reçois des bases de données sous excel de format variable en lignes
et colonnes
Je dois envoyer à chaque Région, quelquefois chaque Agence les données=

qui les concernent.

Pour l'instant j'utilise l'option filtre élaboré sur un nouvel onglet
avec comme critère la Région ou l'agence puis j'enregistre l'onglet
dans un nouveau classeur.

Mais j'aimerai pouvoir disposer d'une macro qui crée un classeur par
Région à partir de la base originale.
Si le classeur original est vente_janvier, le classeur cible serait
idf_vente_janvier, ra_vente_janvier
etc.

Ci dessous un exemple de la base réduite Vente_janvier.
REGION AGENCE COMMERCIAL CLIENT PRODUIT
CVL JEANCVL RCO CVL12124 5J0312
CVL PARTCVL CDE CVL12123 5J0312
LR BOURLR PMO LR11553 5J0313
PACA CHARPACA CFI PACA12278 5J0313
PACA GRATPACA BEE PACA12130 5J0312
PACA LE BPACA BEE PACA12114 5J0312
PACA SAINPACA RCO PACA12292 5J0313
PACA UNITPACA BEE PACA12218 5J0312
PIC BOURPIC CFI PIC12279 5J0313
RA JULERA RCO RA12156 5J0312

L e résultat serait 5 classeurs CVLVente_janvier (2 enregistrements);
LRVente_janvie r(1_enregistrement); PACAVente_janvier (5
enregistrements) ; PICVente_janvier (1_enregistrement);
RAVente_janvier (1_enregistrement);

Merci d'avance.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
robocor
Le #5243541
Bonjour,
Je rajoute le lien pour le fichier exemple
http://cjoint.com/?cuogKPHXKx

Merci
JB
Le #5243531
Bonjour,

Sub CreeClasseurs()
Application.DisplayAlerts = False
[A1:E10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1],
Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets.Add
Sheets("BD").[A1:E10000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("BD").[G1:G2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets("BD").Select
Next c
End Sub

http://cjoint.com/?cuopm88iLS

JB
http://boisgontierjacques.free.fr

On 20 fév, 13:56, robocor
Bonjour à tous,

Voici mon problème :
Je reçois des bases de données sous excel de format variable en lignes
et colonnes
Je dois envoyer à chaque Région, quelquefois chaque Agence les donné es
qui les concernent.

Pour l'instant j'utilise l'option filtre élaboré sur un nouvel onglet
avec comme critère la Région ou l'agence puis j'enregistre l'onglet
dans un nouveau classeur.

Mais j'aimerai pouvoir disposer d'une macro qui crée un classeur par
Région à partir de la base originale.
Si le classeur original est vente_janvier, le classeur cible serait
idf_vente_janvier, ra_vente_janvier
etc....

Ci dessous un exemple de la base réduite Vente_janvier.
REGION  AGENCE    COMMERCIAL    CLIENT  PRODUIT
CVL     JEANCVL    RCO                 CVL12124   5J0312
CVL     PARTCVL    CDE                 CVL12123   5J0312
LR      BOURLR     PMO                 LR11553     5J0313
PACA    CHARPACA CFI                   PACA12278   5J0313
PACA    GRATPACA BEE                   PACA12130   5J0312
PACA    LE BPACA   BEE                 PACA12114   5J0312
PACA    SAINPACA   RCO                 PACA12292   5J0313
PACA    UNITPACA   BEE                 PACA12218   5J0312
PIC     BOURPIC    CFI                 PIC12279   5J0313
RA      JULERA     RCO                 RA12156    5J0312

L e résultat serait 5 classeurs CVLVente_janvier (2 enregistrements);
LRVente_janvie r(1_enregistrement); PACAVente_janvier (5
enregistrements) ; PICVente_janvier (1_enregistrement);
RAVente_janvier (1_enregistrement);

Merci d'avance.


JB
Le #5243501
http://cjoint.com/?cuoJosNYYr

Sub CreeClasseurs()
Application.DisplayAlerts = False
Sdbl
For Each c In Range("H2", Range("H65000").End(xlUp))
Range("H2") = c
Sheets.Add
Sheets("Feuil1").[A1:F10000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[H1:H2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets("Feuil1").Select
Next c
End Sub

Sub Sdbl()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range([d2], [d65000].End(xlUp))
temp = txt(c.Value)
If Not MonDico.Exists(temp) Then MonDico.Add temp, temp
Next c
[H2].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.items)
End Sub

Function txt(x)
For i = 1 To Len(x)
If Mid(x, i, 1) >= "A" And Mid(x, i, 1) <= "Z" Then
temp = temp & Mid(x, i, 1)
End If
Next i
txt = temp
End Function


On 20 fév, 14:15, JB
Bonjour,

Sub CreeClasseurs()
  Application.DisplayAlerts = False
  [A1:E10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1] ,
Unique:=True
  For Each c In Range("G2", Range("G65000").End(xlUp))
    Range("G2") = c
    Sheets.Add
    Sheets("BD").[A1:E10000].AdvancedFilter Action:=xlFilterCopy, _
       CriteriaRange:=Sheets("BD").[G1:G2], CopyToRange:=[A1],
Unique:úlse
    ActiveSheet.Copy
    ActiveSheet.Name = c
    ActiveWorkbook.SaveAs Filename:=c
    ActiveWorkbook.Close
    ActiveSheet.Delete
    Sheets("BD").Select
  Next c
End Sub

http://cjoint.com/?cuopm88iLS

JBhttp://boisgontierjacques.free.fr

On 20 fév, 13:56, robocor


Bonjour à tous,

Voici mon problème :
Je reçois des bases de données sous excel de format variable en lign es
et colonnes
Je dois envoyer à chaque Région, quelquefois chaque Agence les donn ées
qui les concernent.

Pour l'instant j'utilise l'option filtre élaboré sur un nouvel ongle t
avec comme critère la Région ou l'agence puis j'enregistre l'onglet
dans un nouveau classeur.

Mais j'aimerai pouvoir disposer d'une macro qui crée un classeur par
Région à partir de la base originale.
Si le classeur original est vente_janvier, le classeur cible serait
idf_vente_janvier, ra_vente_janvier
etc....

Ci dessous un exemple de la base réduite Vente_janvier.
REGION  AGENCE    COMMERCIAL    CLIENT  PRODUIT
CVL     JEANCVL    RCO                 CVL12124   5J0312
CVL     PARTCVL    CDE                 CVL12123   5J0312
LR      BOURLR     PMO                 LR11553     5J0313
PACA    CHARPACA CFI                   PACA12278  5J0313
PACA    GRATPACA BEE                   PACA12130   5J0312
PACA    LE BPACA   BEE                 PACA12114   5J0312
PACA    SAINPACA   RCO                 PACA12292  5J0313
PACA    UNITPACA   BEE                 PACA12218  5J0312
PIC     BOURPIC    CFI                 PIC12279   5J0313
RA      JULERA     RCO                 RA12156    5J0312

L e résultat serait 5 classeurs CVLVente_janvier (2 enregistrements);
LRVente_janvie r(1_enregistrement); PACAVente_janvier (5
enregistrements) ; PICVente_janvier (1_enregistrement);
RAVente_janvier (1_enregistrement);

Merci d'avance.- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



robocor
Le #5243431
Bonjour,

J'en ai rêvé.

Jacques l'a fait.........

Solution ultra rapide élégante et conforme à mon souhait.

Merci.

La première fois la macro a bloqué sur l'enregistrement du premier
classeur (je n'ai pas compris pourquoi)
La commande de débogage surlignait la ligne ActiveSheet.Name = c
Les autres fois la macro s'est exécutée sans problème.
J'ai testé sur les bases complètes, un seul obstacle rencontré lorsque
le nombre de caractères d'un des critères dépasse 31 caractères
JB
Le #5243421
Pour éviter le message (noms>31), supprimer cette ligne:

ActiveSheet.Name = c

http://cjoint.com/?cup2NuBfL7

JB


On 20 fév, 15:30, robocor
Bonjour,

J'en ai rêvé.

Jacques l'a fait.........

Solution ultra rapide élégante et conforme à mon souhait.

Merci.

La première fois la macro a bloqué sur l'enregistrement du premier
classeur (je n'ai pas compris pourquoi)
La commande de débogage surlignait la ligne ActiveSheet.Name = c
Les autres fois la macro s'est exécutée sans problème.
J'ai testé sur les bases complètes, un seul obstacle rencontré lorsq ue
le nombre de caractères d'un des critères dépasse 31 caractères


Publicité
Poster une réponse
Anonyme