Decouper un fichier en plusieurs plus petits

Le
max-75
Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.


Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.


http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/thread/4=
864bb23fc3f32da?scoring=d&q=decouper+un+tableau&hl=fr

merci d'avance

Akim


--
Sub Découper()


Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String


'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"


'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"


'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)


Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With


Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)


Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--
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
lSteph
Le #4630471
Bonjour,

Possibilité manuelle.
Etablis la liste de tous les responsables.
Dupliques ton classeur en autant que de responsables
Dans chacun tu mets la liste où en face du nom du responsable de
chaque classeur tu mets 1 et tous les autres 2.
En groupe de travail tu insère dans chaque feuille une colonne qui lit
le nom du responsable et ajoute le numéro correspondant selon la
liste.
Tu trie chaque feuille, tu gardes tout ce qui est 1 et supprime tout
ce qui est 2.

Cordialement.

lSteph


On 25 juil, 15:16, max-75
Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th...

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------


Paul V
Le #4630441
hello à tous,

Je ne connais pas la structure de ton classeur donc je propose une
solution peut-être irréaliste.

Il me semble que tu pourrais créer un tableau croisé qui regroupe les
données des diverses feuilles.
Ce tableau prendrais les responsable en page.
Ensuite lancer "afficher les pages" qui créerait les divers tableaux que
tu as besoin.

HTH

Paul V


Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.


Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.


http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/thread/4864bb23fc3f32da?scoring=d&qÞcouper+un+tableau&hl=fr

merci d'avance

Akim


--------------------------------------
Sub Découper()


Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String


'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"


'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"


'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)


Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With


Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)


Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------



max-75
Le #4630301
On 25 juil, 15:35, lSteph
Bonjour,

Possibilité manuelle.
Etablis la liste de tous les responsables.
Dupliques ton classeur en autant que de responsables
Dans chacun tu mets la liste où en face du nom du responsable de
chaque classeur tu mets 1 et tous les autres 2.
En groupe de travail tu insère dans chaque feuille une colonne qui lit
le nom du responsable et ajoute le numéro correspondant selon la
liste.
Tu trie chaque feuille, tu gardes tout ce qui est 1 et supprime tout
ce qui est 2.

Cordialement.

lSteph

On 25 juil, 15:16, max-75


Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th...

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------- Masquer le texte des messages précédents -


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


bonjour Isteph,

C'est pour eviter ce cote fastidieux que je souhaitais une macro du
genre de celle cite en exemple..
Aujourdh'ui, je dois creer un filtre auto, filtrer la premiere feuille
selon le premier responsable de la liste, copier les donnees relative
à ce classeur, en creer un nouveau à son nom, le reformater (nom des
onglets) coller les infos, partir sur la seconde feuille du classeur
source filtrer avec le meme nom, reformater le second onglet et
coller, repeter cette operation autant de fois par onglet puis ensuite
autant de fois que de responsables. Une fois que tous les noms de la
premiere feuille ont ete filtrees, recommencer avec ceux de la seconde
feuille en recherchant ceux qui n'ont pas ete traite par le premier
passage....trop fastidieux. Tu ajoutes à celà les interruption
intempestives des collegues et tu multiplies le risque d'erreurs ...


JB
Le #4630271
Bonjour,


Sub CreeClasseurs()
Application.DisplayAlerts = False
Sheets("consolide").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("BD1", "BD2", "BD3")
Range(Sheets(s).[A2], Sheets(s).
[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
Next s
'--
[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1],
Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets("Modèle").Select
Sheets("Consolide").[A1:D10000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("consolide").[G1:G2], _
CopyToRange:=Sheets("Modèle").[A1:C1], Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("consolide").Select
Next c
End Sub

http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursResponsable .xls

JB

On 25 juil, 15:16, max-75
Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th...

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------


max-75
Le #4630251
On 25 juil, 15:49, Paul V
hello à tous,

Je ne connais pas la structure de ton classeur donc je propose une
solution peut-être irréaliste.

Il me semble que tu pourrais créer un tableau croisé qui regroupe les
données des diverses feuilles.
Ce tableau prendrais les responsable en page.
Ensuite lancer "afficher les pages" qui créerait les divers tableaux que
tu as besoin.

HTH

Paul V




Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th...

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------- Masquer le texte des messages précédents -


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


ca pourrait marcher....
pour preciser un peu, je travaille avec des extractions de base oracle
(-> liste avec entetes). L'idee est que ces extractions traquent les
anomalies (donnee manquante, incoherente....).
Chaque requete SQL retourne son resultat dans une feuille. J'actualise
les requetes est l'idee et d'envoyer un classeur à chaque personne
responsable de la saisie pour qu'elle corrige ses erreurs...

je souhaiterai eviter de decouper mon fichier d'origine pour n'avoir
qu'une feuille et utiliser la macro cite car j'ai l'intention de
developper beaucoup de queries et je prefere pour de questions
d'organiseation garder 1 classeur par type de requetes...

Voili voila.

Si quelqu'un pouvais m'aider à adapter la macro ou m'indiquer une
script equivalent...

merci

Akim


max-75
Le #4630181
On 25 juil, 17:18, JB
Bonjour,

Sub CreeClasseurs()
Application.DisplayAlerts = False
Sheets("consolide").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("BD1", "BD2", "BD3")
Range(Sheets(s).[A2], Sheets(s).
[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
Next s
'--
[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1],
Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets("Modèle").Select
Sheets("Consolide").[A1:D10000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("consolide").[G1:G2], _
CopyToRange:=Sheets("Modèle").[A1:C1], Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("consolide").Select
Next c
End Sub

http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursRespo...

JB

On 25 juil, 15:16, max-75


Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th...

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------- Masquer le texte des messages précédents -


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


Super JB,

Ce classeur va m'etre tres utile pour une autre activite.
Ici cependant, l'information d'origine est volontairement repartie
dans differents onglets car elle repond à differentes requete.
Je vais preciser et simplifier un peu le context.
jai un classeur qui regroupe dans chaque onglet un type d'erreur de
saisie ou de donnee manquante.
ex:
onglet1: extraction avec entete des commandes où il manque le nom du
commercial...
onglet2: extraction avec entete des commandes où il manque le num de
tel...
Chaque onglet comporte entre autres une colonne avec le nom de la
personne à contacter pour corriger la saisie.
L'idee est de fournir un fichier excell à chaque personne qui reprends
chaque onglet telquel mais filtre avec les info qui la concerne.
Ainsi, TATA recoit un fichier excell comportant en onglet1 toutes ses
commandes ou elle doit ajouter le nom du commercial, en onglet2 celle
ou il manque un num de tel...


lSteph
Le #4630151
Ce que j'envisageais est un shema qui peut s'agrémenter de
fonctionnalités et macros au besoin.
Ce que tu décris paraît nettement plus compliqué mais simplifiable
déjà , en mettant tous tes champs responsable sur une seule feuille,
les uns en dessous des autres et tu n'a plus q'un seul filtre élaboré
sans doublons à lancer pour avoir ta liste
à moins que tu aies 30 feuilles avec 2000 responsables par feuille!
Ce serait une sacrée maison!

Sinon puisque tu l'évoques, SQL, ne te permettrait il pas de prévoir
une requête par responsable.

Cordialement.

lSteph


C'est pour eviter ce cote fastidieux que je souhaitais une macro du
genre de celle cite en exemple..
Aujourdh'ui, je dois creer un filtre auto, filtrer la premiere feuille
selon le premier responsable de la liste, copier les donnees relative
à ce classeur, en creer un nouveau à son nom, le reformater (nom des
onglets) coller les infos, partir sur la seconde feuille du classeur
source filtrer avec le meme nom, reformater le second onglet et
coller, repeter cette operation autant de fois par onglet puis ensuite
autant de fois que de responsables. Une fois que tous les noms de la
premiere feuille ont ete filtrees, recommencer avec ceux de la seconde
feuille en recherchant ceux qui n'ont pas ete traite par le premier
passage....trop fastidieux. Tu ajoutes à celà les interruption
intempestives des collegues et tu multiplies le risque d'erreurs ...


JB
Le #4629951
Chaque responsable ne voit que ses lignes:

Sub CreeClasseurs()
Application.ScreenUpdating = False
For Each Responsable In Range(Sheets("ListeResp").[A2],
Sheets("ListeResp").[A65000].End(xlUp))
répertoire = ThisWorkbook.Path
ThisWorkbook.SaveCopyAs répertoire & "" & Responsable & ".xls"
Workbooks.Open Filename:=Responsable
For Each s In Array("bd1", "bd2", "bd3")
Sheets(s).Activate
[A1].AutoFilter Field:=2, Criteria1:="<>" & Responsable
Range("_FilterDataBase").Offset(1,
0).Resize(Range("_FilterDataBase"). _
Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
Shift:=xlUp
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Next s
Application.DisplayAlerts = False
Sheets("listeresp").Delete
ActiveWorkbook.Save
ActiveWorkbook.Close
Next Responsable
End Sub

http://cjoint.com/?hzwjLvDXYE

JB

On 25 juil, 18:27, max-75
On 25 juil, 17:18, JB




Bonjour,

Sub CreeClasseurs()
Application.DisplayAlerts = False
Sheets("consolide").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("BD1", "BD2", "BD3")
Range(Sheets(s).[A2], Sheets(s).
[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
Next s
'--
[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1 ],
Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets("Modèle").Select
Sheets("Consolide").[A1:D10000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("consolide").[G1:G2], _
CopyToRange:=Sheets("Modèle").[A1:C1], Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("consolide").Select
Next c
End Sub

http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursRespo...

JB

On 25 juil, 15:16, max-75
Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th. ..

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------- Masquer le texte des message s précédents -


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


Super JB,

Ce classeur va m'etre tres utile pour une autre activite.
Ici cependant, l'information d'origine est volontairement repartie
dans differents onglets car elle repond à differentes requete.
Je vais preciser et simplifier un peu le context.
jai un classeur qui regroupe dans chaque onglet un type d'erreur de
saisie ou de donnee manquante.
ex:
onglet1: extraction avec entete des commandes où il manque le nom du
commercial...
onglet2: extraction avec entete des commandes où il manque le num de
tel...
Chaque onglet comporte entre autres une colonne avec le nom de la
personne à contacter pour corriger la saisie.
L'idee est de fournir un fichier excell à chaque personne qui reprends
chaque onglet telquel mais filtre avec les info qui la concerne.
Ainsi, TATA recoit un fichier excell comportant en onglet1 toutes ses
commandes ou elle doit ajouter le nom du commercial, en onglet2 celle
ou il manque un num de tel...- Masquer le texte des messages précéden ts -

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




JB
Le #4629911
http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursResponsable 2.xls

JB

On 25 juil, 18:27, max-75
On 25 juil, 17:18, JB




Bonjour,

Sub CreeClasseurs()
Application.DisplayAlerts = False
Sheets("consolide").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("BD1", "BD2", "BD3")
Range(Sheets(s).[A2], Sheets(s).
[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
Next s
'--
[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1 ],
Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets("Modèle").Select
Sheets("Consolide").[A1:D10000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("consolide").[G1:G2], _
CopyToRange:=Sheets("Modèle").[A1:C1], Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("consolide").Select
Next c
End Sub

http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursRespo...

JB

On 25 juil, 15:16, max-75
Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiterai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feuille
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th. ..

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------- Masquer le texte des message s précédents -


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


Super JB,

Ce classeur va m'etre tres utile pour une autre activite.
Ici cependant, l'information d'origine est volontairement repartie
dans differents onglets car elle repond à differentes requete.
Je vais preciser et simplifier un peu le context.
jai un classeur qui regroupe dans chaque onglet un type d'erreur de
saisie ou de donnee manquante.
ex:
onglet1: extraction avec entete des commandes où il manque le nom du
commercial...
onglet2: extraction avec entete des commandes où il manque le num de
tel...
Chaque onglet comporte entre autres une colonne avec le nom de la
personne à contacter pour corriger la saisie.
L'idee est de fournir un fichier excell à chaque personne qui reprends
chaque onglet telquel mais filtre avec les info qui la concerne.
Ainsi, TATA recoit un fichier excell comportant en onglet1 toutes ses
commandes ou elle doit ajouter le nom du commercial, en onglet2 celle
ou il manque un num de tel...- Masquer le texte des messages précéden ts -

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




max-75
Le #4861471
On 25 juil, 22:59, JB
http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursRespo...

JB

On 25 juil, 18:27, max-75


On 25 juil, 17:18, JB
Bonjour,

Sub CreeClasseurs()
Application.DisplayAlerts = False
Sheets("consolide").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("BD1", "BD2", "BD3")
Range(Sheets(s).[A2], Sheets(s).
[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
Next s
'--
[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[ g1],
Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets("Modèle").Select
Sheets("Consolide").[A1:D10000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("consolide").[G1:G2], _
CopyToRange:=Sheets("Modèle").[A1:C1], Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("consolide").Select
Next c
End Sub

http://boisgontierjacques.free.fr/fichiers/Onglets/CreeClasseursRespo. ..

JB

On 25 juil, 15:16, max-75
Bonjour à tous,

J'ai regulierement un classeur qui contient plusieurs feuilles.
J'ai une colonne 'responsable' dans chaque feuilles et je souhaiter ai
creer un classeur par responsable afin de leur envoyer.
Chaque classeur ainsi genere serait une image de mon classeur
d'origine mais ne comportant que les donnees relatives à chaque
responsables.
contrainte: il faudra scanner la colonne responsable de chaque feui lle
pour en avoir la liste exhaustive.

Ce script de michdenis, publie le 24nov 2005 correspond exactement à
ma demande sauf qu'il ne s'applique qu'à une feuille alors que je
souhaiterais que le filtre s'applique à tous mes onglets.

http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/t h...

merci d'avance

Akim

--------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Feuil1").Copy before:=Sheets(1)

Set Sh = ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A1:N" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub
'--------------------------------------- Masquer le texte des messa ges précédents -


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


Super JB,

Ce classeur va m'etre tres utile pour une autre activite.
Ici cependant, l'information d'origine est volontairement repartie
dans differents onglets car elle repond à differentes requete.
Je vais preciser et simplifier un peu le context.
jai un classeur qui regroupe dans chaque onglet un type d'erreur de
saisie ou de donnee manquante.
ex:
onglet1: extraction avec entete des commandes où il manque le nom du
commercial...
onglet2: extraction avec entete des commandes où il manque le num de
tel...
Chaque onglet comporte entre autres une colonne avec le nom de la
personne à contacter pour corriger la saisie.
L'idee est de fournir un fichier excell à chaque personne qui reprends
chaque onglet telquel mais filtre avec les info qui la concerne.
Ainsi, TATA recoit un fichier excell comportant en onglet1 toutes ses
commandes ou elle doit ajouter le nom du commercial, en onglet2 celle
ou il manque un num de tel...- Masquer le texte des messages précéd ents -

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


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


D'apres mes tests, c'est exactement ce que je cherchais.
merci infiniment

Akim




Publicité
Poster une réponse
Anonyme