Gestion de feuilles

Le
David Vincent
Bonsoir à Toutes et tous

Avec Excel XP j'essaie en VBA sans toutefois y parvenir d'inserer après ma
feuille N°2 les feuilles (01;02;03;04;05;06;et 09)

En feuille 1 j'ai 8000 lignes sur 10 colonnes dont en colonnes A les
secteurs de 01 à 06 et 09.

Le but est de répartir par filtre les données des secteurs sur chacune des
feuilles correspondantes.
J'y ai passé l'après midi sans succès

Pouvez vous m'aidez?

D'avance merci

DV
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #4758211
Bonsoir,

http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm#CréationO nglets2

JB

On 29 août, 19:18, "David Vincent"
Bonsoir à Toutes et tous

Avec Excel XP j'essaie en VBA sans toutefois y parvenir d'inserer après ma
feuille N°2 les feuilles (01;02;03;04;05;06;et 09)...

En feuille 1 j'ai 8000 lignes sur 10 colonnes dont en colonnes A les
secteurs de 01 à 06 et 09.

Le but est de répartir par filtre les données des secteurs sur chacun e des
feuilles correspondantes.
J'y ai passé l'après midi sans succès...

Pouvez vous m'aidez?

D'avance merci

DV


JB
Le #4758161
Sub Extrait()
Sheets("edibase").Select
'--- Liste des services
[A1:J10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[M1],
Unique:=True
Sheets("edibase").Select
For Each c In Range("M2", [M65000].End(xlUp)) ' pour chaque
service
[M2] = c.Value
On Error Resume Next
Sheets(c.Value).Select ' la feuille existe t-
elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = c.Value
End If
'-- extraction
Sheets("edibase").[A1:J10000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("edibase").[M1:M2],
CopyToRange:=[A1:J1]
Sheets("edibase").Select
Next c
End Sub

http://cjoint.com/?iDual28dBc


JB

On 29 août, 19:28, JB
Bonsoir,

http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm#Créatio nOnglets2

JB

On 29 août, 19:18, "David Vincent"


Bonsoir à Toutes et tous

Avec Excel XP j'essaie en VBA sans toutefois y parvenir d'inserer apr ès ma
feuille N°2 les feuilles (01;02;03;04;05;06;et 09)...

En feuille 1 j'ai 8000 lignes sur 10 colonnes dont en colonnes A les
secteurs de 01 à 06 et 09.

Le but est de répartir par filtre les données des secteurs sur chac une des
feuilles correspondantes.
J'y ai passé l'après midi sans succès...

Pouvez vous m'aidez?

D'avance merci

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


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



David Vincent
Le #4758151
Bonsoir JB

J'ai adapté ta procédure à mon classeur...

Résultat

La feuille modèle ne se créé pas
Les données en feuil1 ont disparues
La liste des secteurs se fait bien en colonne N
La proc tourne depuis 5 mn j'ai été obligé de la stopper...
La feuille "Modèle" se créé bien par la proc ?
Voici mon code
Où ai-je M---?
Sub Extrait()
Sheets("Feuil1").Select
'--- Liste des services
[A1:M8000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[N1],
Unique:=True
Sheets("edibase").Select
For Each c In Range("N2", [N65000].End(xlUp)) ' pour chaque service
[N2] = c.Value
On Error Resume Next
Sheets(c.Value).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = c.Value
End If
'-- extraction
Sheets("Feuil1").[A1:M8000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[N1:N2], CopyToRange:=[A1:M1]
Sheets("edibase").Select
Next c
End Sub

Encore merci de ton aide

Cordialement



DV
JB
Le #4758111
-La feuille modèle doit exister.
-La premiere ligne du modele doit contenir les titres de la B2.
-Exécuter la macro en pas à pas avec F8

JB
On 29 août, 20:09, "David Vincent"
Bonsoir JB

J'ai adapté ta procédure à mon classeur...

Résultat

La feuille modèle ne se créé pas
Les données en feuil1 ont disparues
La liste des secteurs se fait bien en colonne N
La proc tourne depuis 5 mn j'ai été obligé de la stopper...
La feuille "Modèle" se créé bien par la proc ?
Voici mon code
Où ai-je M---?
Sub Extrait()
Sheets("Feuil1").Select
'--- Liste des services
[A1:M8000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[N1],
Unique:=True
Sheets("edibase").Select
For Each c In Range("N2", [N65000].End(xlUp)) ' pour chaque service
[N2] = c.Value
On Error Resume Next
Sheets(c.Value).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = c.Value
End If
'-- extraction
Sheets("Feuil1").[A1:M8000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[N1:N2], CopyToRange:=[A1:M1]
Sheets("edibase").Select
Next c
End Sub

Encore merci de ton aide

Cordialement

DV


David Vincent
Le #4758061
re Bonsoir JB

Avec F8 j'obtiens la Feuil1 qui prend le nom de chaque service a tour de
rôle mais garde toutes les données...
Les feuilles ne se créent pas?

code utilisé
PS il y a une feuille Infos et une Feuille Feuil2 por informations

Sub Extrait()
Sheets("Feuil1").Select
'--- Liste des services
[A1:M8000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[N1],
Unique:=True
Sheets("Feuil1").Select
For Each c In Range("N2", [N65000].End(xlUp)) ' pour chaque service
[N2] = c.Value
On Error Resume Next
Sheets(c.Value).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = c.Value
End If
'-- extraction
Sheets("Feuil1").[A1:M8000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[N1:N2], CopyToRange:=[A1:M1]
Sheets("Feuil1").Select
Next c
End Sub


Cordialement

DV
JB
Le #4758011
Remplacer:

Sheets(c.Value).Select

par

Sheets(CStr(c.Value)).Select

JB

On 29 août, 20:32, "David Vincent"
re Bonsoir JB

Avec F8 j'obtiens la Feuil1 qui prend le nom de chaque service a tour de
rôle mais garde toutes les données...
Les feuilles ne se créent pas?

code utilisé
PS il y a une feuille Infos et une Feuille Feuil2 por informations

Sub Extrait()
Sheets("Feuil1").Select
'--- Liste des services
[A1:M8000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[N1],
Unique:=True
Sheets("Feuil1").Select
For Each c In Range("N2", [N65000].End(xlUp)) ' pour chaque service
[N2] = c.Value
On Error Resume Next
Sheets(c.Value).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' créati on
ActiveSheet.Name = c.Value
End If
'-- extraction
Sheets("Feuil1").[A1:M8000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[N1:N2], CopyToRange:=[A1 :M1]
Sheets("Feuil1").Select
Next c
End Sub

Cordialement

DV


David Vincent
Le #4758001
JB

J'ai remplacé comme tu m'as conseillé mais rien de plus ni de moins.

Je ne suis pas spécialiste du VBA j'essaie de décortiquer cette proc mais
Pfff

Enfin c'est comme ça qu'on progresse.

Ce qu'il y a de bien c'est que vu d'où je parts il y a un long chemin à
faire...

Encore merci de ton aide

DV
JB
Le #4757981
Envoi un échantillon de ta BD (10 lignes )

JB
On 29 août, 21:00, "David Vincent"
JB

J'ai remplacé comme tu m'as conseillé mais rien de plus ni de moins.

Je ne suis pas spécialiste du VBA j'essaie de décortiquer cette proc mais
Pfff

Enfin c'est comme ça qu'on progresse.

Ce qu'il y a de bien c'est que vu d'où je parts il y a un long chemin à
faire...

Encore merci de ton aide

DV


David Vincent
Le #4757951
Bonsoir JB

Voici le fichier (10 lignes)

http://cjoint.com/?iDvoxLdEsS

Bonne réception

DV
JB
Le #4757901
http://cjoint.com/?iDvEZXLVOC

JB

On 29 août, 21:15, "David Vincent"
Bonsoir JB

Voici le fichier (10 lignes)

http://cjoint.com/?iDvoxLdEsS

Bonne réception

DV


Publicité
Poster une réponse
Anonyme