Extraction selon condition

[Celine57]

J'ai déjà régler le problème de la création d'onglets automatique selon une liste, maintenant, j'ai souhaite dire à excel selon un modèle type d'extraire les données dans chaque sous tableau et dans chaque onglet.

j'ai par exemple, francis, sandra et jean philippe qui travaillent sur plusieurs dossiers, dossier compta, dossier secretariat et dossier educatif.

Je souhaiterai créer selon un modèle avec 3 sous-tableaux dans chaque onglet (compta - secretariat - educatif) l'extraction de toutes les données qui se trouvent dans une base de données commune.

voilà le code qui permet de créer un onglet selon une liste :

Sub Extrait()

Dim plage As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set f = Sheets("base")
'--- Liste des travées
f.[J1] = f.[G1]
f.[A1:G10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[J1], Unique:=True
For Each c In f.Range("J2:J" & f.[J65000].End(xlUp).Row) ' pour chaque travée
On Error Resume Next
onglet = CStr(c.Value)
Sheets(onglet).Delete
On Error GoTo 0
Sheets("modèle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = onglet
'-- extraction



ligne = 2
For i = 2 To f.[A65000].End(xlUp).Row
If CStr(f.Cells(i, "G")) = onglet Then
Cells(ligne, "A") = f.Cells(i, "G")
Cells(ligne, "J") = f.Cells(i, "D")
Cells(ligne, "I") = f.Cells(i, "C")
ligne = ligne + 1
End If
Next i
Next c
End Sub


En faite c'est la boucle qui permet de dire à excel tant qu'il y a un nom sur la liste (onglet à créer), créer selon modèle avec 3 sous tableaux sur le même onglet en répartissant les données compta, educatif et secrétariat.

Quelqu'un pourrait m'aider svp à concevoir la macro ?

 

[titiborregan5]

Re : Extraction selon condition

Bonjour Céline, bonjour à tous,

bienvenue sur excel-downloads...
Afin d'avoir plus de réponses et qu'elles soient plus adaptées à ta demande, le mieux est de mettre un fichier exemple, sans donnée confidentielle évidemment ...

J'ai vu que tu avais fait un filtre élaboré pour récupérer les noms sans doublon et créer tes onglets...
tu peux faire la même chose en rajoutant un critère (celui du nom si j'ai bien compris)...

En espérant que ça te mette sur la bonne voie, sinon mets un fichier exemple j'essaierai de regarder!

A+

Tibo

 

[Celine57]

Re : Extraction selon condition

Merci beaucoup Tibo d'avoir répondu à mon message

j'apprécie beaucoup

selon tes conseils, je viens d'ajouter le fichier exemple.

Sa fait trop longtemps que je buche la dessus, et sincèrement ça m'enleverai une belle épine du pied si tu pouvais m'aider.

Kiss

 

[titiborregan5]

Re : Extraction selon condition

Il n'y a aucun fichier joint...

Edit: oups pas vu que c'était rajouté dans le 1er message! désolé! je regarde ça!

 

[Celine57]

Re : Extraction selon condition

Lol

Merci

 

[titiborregan5]

Re : Extraction selon condition

En pj un exemple... tes titres de colonnes dans modèles n'étaient pas bons (aucune correspondance avec la base) donc je les ai modifiés...
En espérant que le code te paraisse compréhensible et ajustable à ta base réelle...

Dim SiGLe

Sub filtre_élaboré()

With Sheets("BD")
.Range("T1") = .Range("A1")
.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, , .Range("T1"), True

For i = 2 To .Range("t65000").End(xlUp).Row
SiGLe = .Cells(i, 20)
Sheets("modèle").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = SiGLe
Sheets(SiGLe).Range("o2") = SiGLe
Sheets(SiGLe).Range("o22") = SiGLe
Sheets(SiGLe).Range("o42") = SiGLe

.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheets(SiGLe).Range("o1:p2"), Sheets(SiGLe).Range("a1:d1"), False
.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheets(SiGLe).Range("o21:p22"), Sheets(SiGLe).Range("a21:d21"), False
.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheets(SiGLe).Range("o41:p42"), Sheets(SiGLe).Range("a41:d41"), False

Next
End With
End Sub

Tibo

 

[Celine57]

Re : Extraction selon condition

Je viens de regarder rapidement, je vais tester encore le module.

Je dois malheureusement quitter, en tout les cas je te remercie infiniment Tibo,

Je t'écrirais surement le compte rendu dès demain

mille merci Tibo, kissssssssssssssssssss