Filtre personnalisé

A ) Dans le fichier transmis, tu n'as aucune feuille dont le nom des onglets
est feuil3 et feuil4 où le résultat de chacun des filtres doit aboutir..

B ) Dans cette ligne de code, modifie le A dans les parenthèses de columns pour 1
comme ceci :
Worksheets("Feuil" & 2 + A).Range("A65536").Columns(1).End(xlUp)(2)

Ton fichier fonctionne à merveille !

Les commentaires que j'ai mis au dessus de chacune des lignes de code,
ça n'a pas un but décoratif et ce n'était pas à l'intention de ton grand-père !



"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
04C598B1-E6C4-4C13-8714-8258FD2A9C86@microsoft.com...
Bonjour
désolé mais je doit être complètement nul car je n'arrive pas a faire
fonctionner ta macro sa tourne mais sans aucun résultat,
si je peut me permettre je te joint mon fichier en te précisant que la
colonne a filtrer est la "AA"
par avance merci de ta réponse

http://cjoint.com/?kbkc42VcSr

L'exemple suivant :

ligne d'étiquette en ligne 5
Données de A6 à CCxx

Zone de critère : "CD1:CD2"

Résultat de ce filtre "SCPI" copiée vers l'onglet Feuil3
Résultat de ce filtre "ACI" copiée vers l'onglet Feuil4

à chaque exécution de la macro, les données se placent à
la suite de ceux déjà existant dans les feuilles de résultat.

Si tu as besoin, tu copies les étiquettes de la feuille de données
vers tes feuilles de résultats.

'--------------------------------
Sub CopierAilleurs()

'Déclaration des variables.
Dim Rg As Range, A As Integer, Elt As Variant

'Empêche le rafraîchessement de l'écran
Application.ScreenUpdating = False

On Error Resume Next

'Une boucle pour chacun des critères
For Each Elt In Array("SCPI", "ACI")
'Variable A -> déterminer le cycle de la boucle
A = A + 1
'Feuille ou le filtre automatique s'exécute
With Worksheets("Feuil1") 'Nom de la feuille à déterminer
'Détermine l'étendue de la plage à filtrer
Set Rg = .Range("A5:CC" & .Range("A65536").End(xlUp).Row)

'Définir la plage de critère:
.Range("CD1") = ""
If A = 1 Then
'Critère pour SCPI
.Range("CD2").FormulaLocal = "=GAUCHE(A6;4)=""" & Elt & """"
Else
'critère pour ACI
.Range("CD2").FormulaLocal = "=GAUCHE(A6;3)=""" & Elt & """"
End If

'Utilisation du filtre élaboré
Rg.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("CD1:CD2"), Unique:úlse

'plage à copier sans la ligne d'étiquette vers Feuil3
'les données se placent à la suite des autres(en dessous)
'à chaque exécution du code
Rg.Offset(1).Resize(Rg.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Feuil" & 2 + A).Range("A65536").Columns(A).End(xlUp)(2)
'Affiche toutes les données (enlève le filtre)
.ShowAllData
.Range("CD2") = ""
End With
Next
'Libération de la mémoire :
Set Rg = Nothing
End Sub
'--------------------------------


"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
80E85D16-9624-418C-B9B4-5C214DD385E6@microsoft.com...
Désole de ne pas être assez claire

je vais donc reformuler la totalité de ma demande
J'ai une BD sur une seul feuille de x lignes qui commence en "A1" jusqu'a
"CC xxx" la ligne 5 étant la ligne d'étiquette je doit recopier dans des
feuilles différentes la totalité des infos de chaque client qui commence par
"SCPI" et je doit regrouper dans une seul feuille tous les clients qui
commence par "SCI" la colonne ou se trouve les clients est la colonne "CC"
J'espère que cela est compréhensible

Merci encore pour votre aide

Si j'ai pris le temps d'expliquer chacune des lignes du code,
tu peux en faire autant en explicitant davantage ce qui se
passe lorsque tu exécutes la macro.

Message d'erreur ? Lequel ?

Tu as pris le soin de vérifier que ton classeur a effectivement
un onglet de feuille "Feuil3", que cette dernière n'est pas protégée ?

Comment je fais pour connaître ton environnement ? Hein ?



"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
E5BB1E35-88CC-4A6E-9C25-A2B6F738666B@microsoft.com...
Merci,
mais quand j'execute l'une ou l'autre des variante la macro bloc a ce niveau :

Rg.Offset(1).Resize(Rg.Rows.Count - 1, _
Rg.Columns.Count).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Feuil3").Range("A65536").Columns(A).End(xlUp)(2)

Je ne suis pas capable de voir pourquoi ?

Une autre variante pour tes 2 cas

'-------------------------------
Sub CopierAilleurs()

'Déclaration des variables.
Dim Rg As Range, A As Integer, Elt As Variant

'Empêche le rafraîchessement de l'écran
Application.ScreenUpdating = False

'Une boucle pour chacun des critères
For Each Elt In Array("SCPI", "ACI")
'Variable A -> déterminer le cycle de la boucle
A = A + 1
'Feuille ou le filtre automatique s'exécute
With Worksheets("Feuil1") 'Nom de la feuille à déterminer
'Détermine l'étendue de la plage à filtrer
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)

'Définir la plage de critère:
.Range("G1") = ""
If A = 1 Then
'Critère pour SCPI
.Range("G2").FormulaLocal = "=GAUCHE(A2;4)=""" & Elt & """"
Else
'critère pour ACI
.Range("G2").FormulaLocal = "=GAUCHE(A2;3)=""" & Elt & """"
End If

'Utilisation du filtre élaboré
Rg.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("G1:G2"), Unique:úlse

'plage à copier sans la ligne d'étiquette vers Feuil3
'les données se placent à la suite des autres(en dessous)
'à chaque exécution du code
Rg.Offset(1).Resize(Rg.Rows.Count - 1, _
Rg.Columns.Count).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Feuil3").Range("A65536").Columns(A).End(xlUp)(2)
'Affiche toutes les données (enlève le filtre)
.ShowAllData
End With
Next
'Libération de la mémoire :
Set Rg = Nothing
End Sub
'-------------------------------



"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
348D57E4-730F-4E8A-9D03-A8B5BBA24546@microsoft.com...
Bonjour,

Merci mais comment traduire cela en macro ?

Utilise le filtre élaboré :

Détermine une zone de critère

G1 = Laisser totalement vide
G2 = la formule suivante : =GAUCHE(A2;4)="SCPI"
A2 = permière cellule de la colonne contenant tes noms , A1 est l'étiquette de colonne.

Tu vas obtenir tous les noms débutant par SCPI dans égard à la casse.

Sélectionne la plage "résultat" de ton filtre
Barre des menus / éditions / atteindre / Cellules / cellules visibles seulement
et tu fais un copier-coller de la plage résultat vers la destination de ton choix.

Tu répètes la même chose pour ton autre cas !


"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
D52E2D5C-19B7-45B4-A4C9-A95160CA7665@microsoft.com...
Bonjour,
je cherche une macro qui récupère dans une collection la liste des noms
différents Personnalisée (je m'explique tous les noms commencent par SCPI
sont considérés comme des noms différents et tous les noms commencent par
ACI son considérés comme une seule entité ) en colonne D puis crée une
feuille par nom et y copie les données
qui concerne ce nom

Si quelqu'un a la solution ?
Merci d'avance

http://cjoint.com/?kbnHxAy2wJ

Sub essai()
Application.DisplayAlerts = False
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range([AA6], [AA65000].End(xlUp))
If Left(c, 3) <> "SCI" Then
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
End If
Next c
For Each c In mondico.items
[AA2] = c
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = Mid(c, 6)
'-- extraction
Sheets("Feuil1").[A5:CC1000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
Next c
'---
c = "SCI"
[AA2] = c & "*"
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = c
Sheets("Feuil1").[A5:CC1000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
End Sub

JB


On 1 oct, 13:21, JB <boisgont...@hotmail.com> wrote:

Bonjour,

http://cjoint.com/?kbnvirIbsR

Sub essai()
Application.DisplayAlerts = False
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range([AA6], [AA65000].End(xlUp))
If Left(c, 3) <> "SCI" Then
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
End If
Next c
For Each c In mondico.items
[AA2] = c
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = c
If Err = 0 Then
'-- extraction onglets
Sheets("Feuil1").[A5:CC1000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
End If
Next c
'---
c = "SCI"
[AA2] = c & "*"
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = c
Sheets("Feuil1").[A5:CC1000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
End Sub

JBhttp://boisgontierjacques.free.fr

On 28 sep, 10:23, JP <J...@discussions.microsoft.com> wrote:

Bonjour,
je cherche une macro qui récupère dans une collection la liste des noms
différents Personnalisée (je m'explique tous les noms commencent pa r SCPI
sont considérés comme des noms différents et tous les noms comme ncent par
ACI son considérés comme une seule entité ) en colonne D puis cr ée une
feuille par nom et y copie les données
qui concerne ce nom

Si quelqu'un a la solution ?
Merci d'avance- Masquer le texte des messages précédents -

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

OK
Merci mille fois ca marche super

http://cjoint.com/?kbnHxAy2wJ

Sub essai()
Application.DisplayAlerts = False
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range([AA6], [AA65000].End(xlUp))
If Left(c, 3) <> "SCI" Then
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
End If
Next c
For Each c In mondico.items
[AA2] = c
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = Mid(c, 6)
'-- extraction
Sheets("Feuil1").[A5:CC1000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
Next c
'---
c = "SCI"
[AA2] = c & "*"
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = c
Sheets("Feuil1").[A5:CC1000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
End Sub

JB


On 1 oct, 13:21, JB <boisgont...@hotmail.com> wrote:

Bonjour,

http://cjoint.com/?kbnvirIbsR

Sub essai()
Application.DisplayAlerts = False
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range([AA6], [AA65000].End(xlUp))
If Left(c, 3) <> "SCI" Then
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
End If
Next c
For Each c In mondico.items
[AA2] = c
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = c
If Err = 0 Then
'-- extraction onglets
Sheets("Feuil1").[A5:CC1000].AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
End If
Next c
'---
c = "SCI"
[AA2] = c & "*"
On Error Resume Next
Sheets(c).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
On Error Resume Next
ActiveSheet.Name = c
Sheets("Feuil1").[A5:CC1000].AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets("Feuil1").[AA1:AA2], CopyToRange:=[A1]
Sheets("feuil1").Select
End Sub

JBhttp://boisgontierjacques.free.fr

On 28 sep, 10:23, JP <J...@discussions.microsoft.com> wrote:

Bonjour,
je cherche une macro qui récupère dans une collection la liste des noms
différents Personnalisée (je m'explique tous les noms commencent par SCPI
sont considérés comme des noms différents et tous les noms commencent par
ACI son considérés comme une seule entité ) en colonne D puis crée une
feuille par nom et y copie les données
qui concerne ce nom

Si quelqu'un a la solution ?
Merci d'avance- Masquer le texte des messages précédents -

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

Ok Merci cela marche au poil

A ) Dans le fichier transmis, tu n'as aucune feuille dont le nom des onglets
est feuil3 et feuil4 où le résultat de chacun des filtres doit aboutir..

B ) Dans cette ligne de code, modifie le A dans les parenthèses de columns pour 1
comme ceci :
Worksheets("Feuil" & 2 + A).Range("A65536").Columns(1).End(xlUp)(2)

Ton fichier fonctionne à merveille !

Les commentaires que j'ai mis au dessus de chacune des lignes de code,
ça n'a pas un but décoratif et ce n'était pas à l'intention de ton grand-père !



"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
04C598B1-E6C4-4C13-8714-8258FD2A9C86@microsoft.com...
Bonjour
désolé mais je doit être complètement nul car je n'arrive pas a faire
fonctionner ta macro sa tourne mais sans aucun résultat,
si je peut me permettre je te joint mon fichier en te précisant que la
colonne a filtrer est la "AA"
par avance merci de ta réponse

http://cjoint.com/?kbkc42VcSr

L'exemple suivant :

ligne d'étiquette en ligne 5
Données de A6 à CCxx

Zone de critère : "CD1:CD2"

Résultat de ce filtre "SCPI" copiée vers l'onglet Feuil3
Résultat de ce filtre "ACI" copiée vers l'onglet Feuil4

à chaque exécution de la macro, les données se placent à
la suite de ceux déjà existant dans les feuilles de résultat.

Si tu as besoin, tu copies les étiquettes de la feuille de données
vers tes feuilles de résultats.

'--------------------------------
Sub CopierAilleurs()

'Déclaration des variables.
Dim Rg As Range, A As Integer, Elt As Variant

'Empêche le rafraîchessement de l'écran
Application.ScreenUpdating = False

On Error Resume Next

'Une boucle pour chacun des critères
For Each Elt In Array("SCPI", "ACI")
'Variable A -> déterminer le cycle de la boucle
A = A + 1
'Feuille ou le filtre automatique s'exécute
With Worksheets("Feuil1") 'Nom de la feuille à déterminer
'Détermine l'étendue de la plage à filtrer
Set Rg = .Range("A5:CC" & .Range("A65536").End(xlUp).Row)

'Définir la plage de critère:
.Range("CD1") = ""
If A = 1 Then
'Critère pour SCPI
.Range("CD2").FormulaLocal = "=GAUCHE(A6;4)=""" & Elt & """"
Else
'critère pour ACI
.Range("CD2").FormulaLocal = "=GAUCHE(A6;3)=""" & Elt & """"
End If

'Utilisation du filtre élaboré
Rg.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("CD1:CD2"), Unique:úlse

'plage à copier sans la ligne d'étiquette vers Feuil3
'les données se placent à la suite des autres(en dessous)
'à chaque exécution du code
Rg.Offset(1).Resize(Rg.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Feuil" & 2 + A).Range("A65536").Columns(A).End(xlUp)(2)
'Affiche toutes les données (enlève le filtre)
.ShowAllData
.Range("CD2") = ""
End With
Next
'Libération de la mémoire :
Set Rg = Nothing
End Sub
'--------------------------------


"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
80E85D16-9624-418C-B9B4-5C214DD385E6@microsoft.com...
Désole de ne pas être assez claire

je vais donc reformuler la totalité de ma demande
J'ai une BD sur une seul feuille de x lignes qui commence en "A1" jusqu'a
"CC xxx" la ligne 5 étant la ligne d'étiquette je doit recopier dans des
feuilles différentes la totalité des infos de chaque client qui commence par
"SCPI" et je doit regrouper dans une seul feuille tous les clients qui
commence par "SCI" la colonne ou se trouve les clients est la colonne "CC"
J'espère que cela est compréhensible

Merci encore pour votre aide

Si j'ai pris le temps d'expliquer chacune des lignes du code,
tu peux en faire autant en explicitant davantage ce qui se
passe lorsque tu exécutes la macro.

Message d'erreur ? Lequel ?

Tu as pris le soin de vérifier que ton classeur a effectivement
un onglet de feuille "Feuil3", que cette dernière n'est pas protégée ?

Comment je fais pour connaître ton environnement ? Hein ?



"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
E5BB1E35-88CC-4A6E-9C25-A2B6F738666B@microsoft.com...
Merci,
mais quand j'execute l'une ou l'autre des variante la macro bloc a ce niveau :

Rg.Offset(1).Resize(Rg.Rows.Count - 1, _
Rg.Columns.Count).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Feuil3").Range("A65536").Columns(A).End(xlUp)(2)

Je ne suis pas capable de voir pourquoi ?

Une autre variante pour tes 2 cas

'-------------------------------
Sub CopierAilleurs()

'Déclaration des variables.
Dim Rg As Range, A As Integer, Elt As Variant

'Empêche le rafraîchessement de l'écran
Application.ScreenUpdating = False

'Une boucle pour chacun des critères
For Each Elt In Array("SCPI", "ACI")
'Variable A -> déterminer le cycle de la boucle
A = A + 1
'Feuille ou le filtre automatique s'exécute
With Worksheets("Feuil1") 'Nom de la feuille à déterminer
'Détermine l'étendue de la plage à filtrer
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)

'Définir la plage de critère:
.Range("G1") = ""
If A = 1 Then
'Critère pour SCPI
.Range("G2").FormulaLocal = "=GAUCHE(A2;4)=""" & Elt & """"
Else
'critère pour ACI
.Range("G2").FormulaLocal = "=GAUCHE(A2;3)=""" & Elt & """"
End If

'Utilisation du filtre élaboré
Rg.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("G1:G2"), Unique:úlse

'plage à copier sans la ligne d'étiquette vers Feuil3
'les données se placent à la suite des autres(en dessous)
'à chaque exécution du code
Rg.Offset(1).Resize(Rg.Rows.Count - 1, _
Rg.Columns.Count).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Feuil3").Range("A65536").Columns(A).End(xlUp)(2)
'Affiche toutes les données (enlève le filtre)
.ShowAllData
End With
Next
'Libération de la mémoire :
Set Rg = Nothing
End Sub
'-------------------------------



"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
348D57E4-730F-4E8A-9D03-A8B5BBA24546@microsoft.com...
Bonjour,

Merci mais comment traduire cela en macro ?

Utilise le filtre élaboré :

Détermine une zone de critère

G1 = Laisser totalement vide
G2 = la formule suivante : =GAUCHE(A2;4)="SCPI"
A2 = permière cellule de la colonne contenant tes noms , A1 est l'étiquette de colonne.

Tu vas obtenir tous les noms débutant par SCPI dans égard à la casse.

Sélectionne la plage "résultat" de ton filtre
Barre des menus / éditions / atteindre / Cellules / cellules visibles seulement
et tu fais un copier-coller de la plage résultat vers la destination de ton choix.

Tu répètes la même chose pour ton autre cas !


"JP" <JP@discussions.microsoft.com> a écrit dans le message de news:
D52E2D5C-19B7-45B4-A4C9-A95160CA7665@microsoft.com...
Bonjour,
je cherche une macro qui récupère dans une collection la liste des noms
différents Personnalisée (je m'explique tous les noms commencent par SCPI
sont considérés comme des noms différents et tous les noms commencent par
ACI son considérés comme une seule entité ) en colonne D puis crée une
feuille par nom et y copie les données
qui concerne ce nom

Si quelqu'un a la solution ?
Merci d'avance