Filtre personnalisé

Le
JP
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
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
MichDenis
Le #4856251
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"
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
JP
Le #4856211
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"
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





MichDenis
Le #4856201
Voici un exemple... tu peux condenser le code lorsque tu auras saisi l'exemple si tu le désires

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

'Déclaration des variables.
Dim Rg As Range, Rg1 As Range, Dest As Range

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

'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") = ""
.Range("G2").FormulaLocal = "=GAUCHE(A2;4)=""SCPI"""

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

'plage à copier sans la ligne d'étiquette
Set Rg1 = Rg.Offset(1).Resize(Rg.Rows.Count - 1, _
Rg.Columns.Count).SpecialCells(xlCellTypeVisible)
'Affiche toutes les données (enlève le filtre)
.ShowAllData
End With

'Déterminer où la copie prendra place
'sur la feuiile de destination
With Worksheets("Feuil3") ''Nom de la feuille à déterminer
Set Dest = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
End With

'copie des données :
Rg1.Copy Dest

'Libération de la mémoire :
Set Rg = Nothing: Set Rg1 = Nothing: Set Dest = Nothing
End Sub
'--------------------------------



"JP"
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"
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





MichDenis
Le #4856181
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"
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"
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





JP
Le #4856141
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"
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"
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










MichDenis
Le #4856121
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"
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"
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"
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










JP
Le #4856061
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"
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"
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"
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















MichDenis
Le #4856041
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"
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"
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"
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"
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















JP
Le #4853251
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"
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"
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"
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"
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




















JB
Le #4853161
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

JB
http://boisgontierjacques.free.fr


On 28 sep, 10:23, JP
Bonjour,
je cherche une macro qui récupère dans une collection la liste des no ms
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 commenc ent 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


Publicité
Poster une réponse
Anonyme