Discussion :

[tyndare36]

Bonjour à toutes et à tous,
Néophyte en VBA je souhaite faire évoluer un code.
Voici le problème :
J’ai une feuille nommée « BD » avec un tableau (voir ci-dessous)

Nom		Service	Salaire		Qualif			
Cowan		Compta	3400		Q2			
Dang		Compta	5000		Q1			
Dupont		Compta	4500		Q1			
Lebosse		Compta	2300		Q2			
Ceuzin		Etudes	3400		Q2			
Dupond		Etudes	5000		Q2			
Durand		Etudes	4500		Q2		        
Dykiel		Etudes	2300		Q1			
Bailleul	Fabric	3400		Q3			
Garcia		Fabric	5000		Q3			
Martin		Fabric	4500		Q1			
Lucien		AAA	2300		Q1			
Tyndare		AAAA	3400		Q3			
Sylvie	 	AAA36	5000		Q3			
Roger		36AAA	4500		Q1

Je souhaite avec un code VBA créer un onglet pour chaque service.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Extrait()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
 
  '--- Liste des services
  f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[G1], Unique:=True
  For Each c In f.Range("G2:G" & f.[G65000].End(xlUp).Row)   ' pour chaque service
     f.[G2] = c.Value
     On Error Resume Next
     Sheets(c.Value).Delete
     On Error GoTo 0
     Sheets.Add After:=Sheets(Sheets.Count)   ' création
     ActiveSheet.Name = c.Value
 
    '-- extraction
     f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G1:G2], CopyToRange:=[A1]
   Next c
End Sub

Maintenant un petit PB.

1.Quand je lance la macro « Sub Extrait() » il y a un résultat incorrect dans l’onglet service « AAA » nous trouvons trois services différents pourquoi ?

Nom	Service	Salaire	Qualif
Lucien	AAA	2300	Q1
Tyndare	AAAA	3400	Q3
Sylvie	AAA36	5000	Q3

Un petit plus est il possible de nommer l’onglet avec la couleur du service en plus ?

Voilà j’espère avoir donné une explication claire sur les problèmes à résoudre.
Merci d’avance à celui ou à celle qui souhaitera m’aider et m'instruire car je souhaite comprendre mçeme si F8 m'aide beaucoup à la compréhension.
J’ai emprunté le code sur la page de http://boisgontierj.free.fr/ que je n’arrive pas à joindre pour au moins le remercier de proposer plein de petits codes en libre service. S’il me lit je le remercie bien fort.
CORDIALEMENT
TYNDARE

[Philippe Tulliez]

Bonjour,
Avec le filtre avancé d'excel (AdvancedFilter), si on veut filtrer une chaîne exacte par exemple Marie.
Dans la zone des critères, il y a lieu de faire précéder cette chaîne par l'apostrophe et l'opérateur logique d'égalité '=Marie ou ="=Marie" afin de ne pas filtrer par exemple Marie-Tina

[tyndare36]

Bonjour Philippe

Tout d'abord merci de prendre sur ton temps pour t'avoir penché sur mon problème.
J'ai essayer ta solution mais cela ne fonctionne pas, me suis-je trompé sur l'emplacement ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Extrait()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  '--- Liste des services
  f.[B1:E10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[G1], Unique:=True
  For Each c In f.Range("G2:G" & f.[G65000].End(xlUp).Row)   ' pour chaque service
     f.[G2] = c.Value
     On Error Resume Next
     Sheets(c.Value).Delete
     On Error GoTo 0
     Sheets.Add After:=Sheets(Sheets.Count)   ' création
     ActiveSheet.Name = c.Value
     '-- extraction
     f.[B1:E10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="=f.[G1:G2]", CopyToRange:=[A1]
   Next c
End Sub

[Philippe Tulliez]

Bonjour,
Difficile de donner une réponse, il faudrait savoir la valeur qu'il y a dans la cellule G2 au moment où il s'agit de filtrer et exporter les données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

f.[B1:E10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="=f.[G1:G2]", CopyToRange:=[A1]

A la lecture de ton code, j'imagine que c'est à la ligne 8

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

   f.[G2] = c.Value

qu'il faudrait faire la modification, sans doute

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 f.[G2] = "=" & Chr(34) & "=" & c.Value & Chr(34)

J'ai fait le test ci-dessous et cela fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 Dim c As Range
 Set c = Range("B14")
 Range("F6") = "=" & Chr(34) & "=" & c.Value & Chr(34)

[tyndare36]

Merci beaucoup Philippe d’avoir pris sur ton temps pour te pencher sur mon problème.
Mais je pense que mon explication du problème est mauvaise donc pour cela je te communique un fichier.
Merci beaucoup

[Philippe Tulliez]

Bonjour,
La réponse que j'ai donnée était correcte cependant je ne savais pas que tu utilisais la même cellule pour créer les feuilles
Donc voici un solution pas très élégante mais je n'ai pas le temps de faire plus aujourd'hui.
La ligne en rouge doit être mise entre la ligne remarque '-- extraction et la ligne de la méthode AdvancedFilter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
     '-- extraction
     f.[G2] = "=" & Chr(34) & "=" & c.Value & Chr(34)
     f.[B1:E10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G1:G2], CopyToRange:=[A5]

L'idéal est d'avoir une zone de critère (G1:G2) indépendante de la plage où tu as placé les catégories.

[tyndare36]

Bonjour Philippe,
un peu de retard pour répondre mais vaut mieux tard que jamais tout cela pour te dire que ton code fonctionne merci beaucoup. Je vais maintenant me lancer sur la mise en oeuvre d'une userform pour remplir une base de données. Connais tu un tutoriel ?

merci encore MERCI