Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Gestion de feuilles

Gestion de feuilles

13 réponses
Avatar
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
JB
Bonsoir,

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

JB

On 29 août, 19:18, "David Vincent" wrote:
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


Avatar
JB
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 wrote:
Bonsoir,

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

JB

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



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 -



Avatar
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
Avatar
JB
-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" wrote:
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


Avatar
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é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
Avatar
JB
Remplacer:

Sheets(c.Value).Select

par

Sheets(CStr(c.Value)).Select

JB

On 29 août, 20:32, "David Vincent" wrote:
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


Avatar
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
Avatar
JB
Envoi un échantillon de ta BD (10 lignes )

JB
On 29 août, 21:00, "David Vincent" wrote:
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


Avatar
David Vincent
Bonsoir JB

Voici le fichier (10 lignes)

http://cjoint.com/?iDvoxLdEsS

Bonne réception

DV
Avatar
JB
http://cjoint.com/?iDvEZXLVOC

JB

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

Voici le fichier (10 lignes)

http://cjoint.com/?iDvoxLdEsS

Bonne réception

DV


1 2