Discussion :

[Kiouane]

Bonjour,

Je souhaiterais filtrer les données de mon tableau en fonction de la valeur des cellules d'une de mes colonnes puis copier toutes les lignes relatives à ces dernières dans une autre feuille. J'ai fais cette petit macro mais en fait ça recopie la même ligne à l'infini lol.

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
Sub VF1_UU1()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
i = 1
Do
 
 If Range("C:C").Find(What:="VF1") Is Nothing Then
    Exit Do
 Else
    Range("C:C").Find(What:="VF1").EntireRow.Copy Destination:=Sheets("Feuil2").Range("A" & i)
 End If
 i = i + 1
Loop
Application.ScreenUpdating = True
End Sub

[Philippe Tulliez]

Bonjour;
Voir du côté des filtres élaborés d'excel (en VBA utilisation de la méthode AdvancedFilter)
A lire éventuellement Les filtres avancés ou élaborés dans Excel

[Kiouane]

Bonjour Philippe,

J'y étais en effet mais vu la taille de mon tableau et le nombre de fichiers à traiter je dois passer par une macro.

Merci pour ta réponse.

Quelqu'un aurait-il une idée de comment régler la boucle infinie?

[Philippe Tulliez]

Bonjour,

J'y étais en effet mais vu la taille de mon tableau et le nombre de fichiers à traiter je dois passer par une macro.

et ai-je écris le contraire ?

Voir du côté des filtres élaborés d'excel (en VBA utilisation de la méthode AdvancedFilter)

cette méthode exporte plus de 100 000 lignes selon critères le temps du clic

Quelqu'un aurait-il une idée de comment régler la boucle infinie?

Prends la peine d'au moins aller jeté un coup d'oeil sur le lien que je t'ai suggéré de lire Les filtres avancés ou élaborés dans Excel

[Kiouane]

J'ai pris la peine de le lire en entier et merci beaucoup. C'est un document riche cependant j'ai une question comment faire le choix du critère sans devoir les définir sur la feuille. C'est à dire en passant directement par la macro. De plus moi je voudrais plutôt couper que copier.

Merci.

[Philippe Tulliez]

Bonjour,
Voici un exemple d'une liste de données (la source) se trouvant sur une feuille nommée [db], commençant en cellule A1, avec en première ligne les étiquettes de colonne et dont la dixième colonne contient une liste de véhicules (étiquette Voiture) dont on veut déplacer les VW (c'est le critère) vers une feuille nommée [Export]. Il y a donc suppression après l'exportation des lignes contenant les VW
La zone des critères est placée deux colonnes à droite de la zone data par la procédure et effacée après l'exportation. D'habitude, j'utilise un critère nommé mais j'ai voulu faire simple
Code de la procédure

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
20
21
22
23
24
25
26
27
28
Sub MoveByAdvancedFilter()
 ' http://philippe.tulliez.be
 Application.ScreenUpdating = False
 ' Déclaration des variables
 Dim areaSource As Range, areaCriteria As Range, areaTarget As Range
 ' Zone Data (Source) & Export (Cible)
 With ThisWorkbook
  Set areaSource = .Worksheets("db").Range("A1").CurrentRegion
  Set areaTarget = .Worksheets("Export").Range("A1")
 End With
 ' Zone des critères 2 colonnes à droite de la zone Data
 With areaSource
  Set areaCriteria = .Offset(columnoffset:=.Columns.Count + 1).Resize(2, 1)
 End With
 ' Ecriture des critères 
 areaCriteria(1) = areaSource.Cells(1, 10)
 areaCriteria(2) = "VW"
 With areaSource
 .AdvancedFilter xlFilterCopy, areaCriteria, areaTarget ' Exportation des données
 .AdvancedFilter xlFilterInPlace, areaCriteria          ' Filtre sur place
  areaCriteria.Clear                                    ' Suppression des critères
  ' Suppression des lignes filtrées
 .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
  With .Worksheet: .Activate: .ShowAllData: End With    ' Supprime le filtre
 End With
 Application.ScreenUpdating = True
 Set areaSource = Nothing: Set areaTarget = Nothing: Set areaCriteria = Nothing
End Sub

[EDIT]
Modifié une erreur dans le texte d'explication

et dont la neuvième dixième colonne contient une liste de véhicules

[Kiouane]

Merci Philippe je vais essayer ça de suite.

Cependant, j'ai adapté ton code à mon fichier. Et il en résulte un message à la ligne 21 : Erreur d'exécution 1004. Erreur définie par l'application ou par l'objet

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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Sub CouperVF1_UU1()
 
 
 
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Export"
 
 Worksheets("PVE_COMPLET").Activate
 
 
 ' Déclaration des variables
 Dim areaSource As Range, areaCriteria As Range, areaTarget As Range
 ' Zone Data (Source) & Export (Cible)
 With ThisWorkbook
  Set areaSource = .Worksheets("PVE_COMPLET").Range("A1").CurrentRegion
  Set areaTarget = .Worksheets("Export").Range("A1")
 End With
 ' Zone des critères 2 colonnes à droite de la zone Data
 With areaSource
  Set areaCriteria = .Offset(columnoffset:=.Columns.Count + 1).Resize(2, 1)
 End With
 ' Ecriture des critères
 areaCriteria(1) = areaSource.Cells(1, 3)
 areaCriteria(2) = "VF1"
 
 With areaSource
 .AdvancedFilter xlFilterCopy, areaCriteria, areaTarget ' Exportation des données
 .AdvancedFilter xlFilterInPlace, areaCriteria          ' Filtre sur place
  areaCriteria.Clear                                    ' Suppression des critères
  ' Suppression des lignes filtrées
 .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
  With .Worksheet: .Activate: .ShowAllData: End With    ' Supprime le filtre
 End With
 
 Set areaSource = Nothing: Set areaTarget = Nothing: Set areaCriteria = Nothing
End Sub

J'ai pu régler le soucis avec ce code, mais je pense que le tien est meilleur. Il faut juste que je sache de quoi résulte le message.

Code :

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

1
2
3
4
5
6
7
8
9
 x = Range("A1").End(xlToRight).Row + 2
 With areaSource
 
  Set areaCriteria = Range(Cells(1, x), Cells(3, x))
 End With
 ' Ecriture des critères
 areaCriteria(1) = areaSource.Cells(1, 3)
 areaCriteria(2) = "VF1"
 areaCriteria(3) = "UU1"

[Philippe Tulliez]

Bonjour,
Je n'avais pas vu qu'il y avait eu modification de ton message d'origine.

Cependant, j'ai adapté ton code à mon fichier. Et il en résulte un message à la ligne 21 : Erreur d'exécution 1004. Erreur définie par l'application ou par l'objet

.
Il faudrait vérifier si l'adresse de areaSource est correcte.
Ligne à placer avant la ligne 21

Code :

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

Debug.Print areaSource.Address

et vérifier dans la fenêtre d'exécution (Ctrl+G) si l'adresse renvoyée est bien correcte.

J'ajoute que ton message initial comprenait un seul critère et que dans ton code j'en voit deux. Il faudrait soit modifier l'adresse de la zone de critère soit utiliser un critère nommé (ce que je préfère pour le type de procédure proposée.

Voici la procédure modifiée avec deux critères et j'ai ajouté un contrôle permettant d'éviter un message d'erreur au cas où aucun enregistrement ne répondrait aux critères

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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub MoveByAdvancedFilter()
 ' http://philippe.tulliez.be
 Application.ScreenUpdating = False
 ' Déclaration des variables et constantes
 Const myFormula = "=OR(J2=""VW"",J2=""Toyota"")"
 Const EvalFormula = "=DCOUNTA([Data],A1,[Criteria])"
 Dim areaSource As Range, areaCriteria As Range, areaTarget As Range
 ' Zone Data (Source) & Export (Cible)
 With ThisWorkbook
  Set areaSource = .Worksheets("db").Range("A1").CurrentRegion
  Set areaTarget = .Worksheets("Export").Range("A1")
 End With
 ' Zone des critères 2 colonnes à droite de la zone Data
     With areaSource
      Set areaCriteria = .Resize(2, 1).Offset(columnoffset:=.Columns.Count + 1)
     End With
     areaCriteria(1) = "_fn_"
     areaCriteria(2) = myFormula
 If Evaluate(Replace(Replace(EvalFormula, "[Data]", areaSource.Address), "[Criteria]", areaCriteria.Address)) Then
     With areaSource
     .AdvancedFilter xlFilterCopy, areaCriteria, areaTarget ' Exportation des données
     .AdvancedFilter xlFilterInPlace, areaCriteria          ' Filtre sur place
      areaCriteria.Clear                                    ' Suppression des critères
      ' Suppression des lignes filtrées
     .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
      With .Worksheet: .Activate: .ShowAllData: End With    ' Supprime le filtre
     End With
   Else
     MsgBox "Pas d'éléments correspondant aux critères"
 End If
 Application.ScreenUpdating = True
 Set areaSource = Nothing: Set areaTarget = Nothing: Set areaCriteria = Nothing
End Sub

[tamtam64]

Bonjour,

Avec un filtre avancé il me semble et le critere en question , à tester, par contre l'idee répond bien à la question. Je ne suis pas certain pour le criteria, mais il me semble que tu peux le mettre en str c'est à dire le critere de selection que tu testais avec ton find.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
With thisworkbook.worksheets("Sheet1")
Set AllRange = .Range(.range("StartS", MyRange.End(xlDown))
 
            AllRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critere,CopyToRange:=.Range("J1"), Unique:=True
         End With
 
         With ThisWorkbook.Worksheets("Sheet2")
                'On clean (Si ya quelque chose sinon on peux le fixer aussi, ca depend)
            Set AllRangeT = .Range(.Range("Start"), .Range("Start").End(xlDown))
            AllRangeT.clearcontents
                'On copy
            AllRangeT.Value = AllRange.Value

Ici on a un filtre special mais je crois qu on peu copier que sur la même feuille c'est pour ca que je copie apres sur une autre feuille avec .value = .value
et ca marche plutot bien et c'est rapide .

PS j'ai nommé mes ranges Start et startS mais ca c'est toi qui vois , tu peux mettre les coordoinnées de la cellule de départ

[Philippe Tulliez]

Bonjour tamtam64,
Est-ce que tu ne t'es pas trompé de discussion ?
Sauf erreur de ma part, la demande de Kiouane est d'exporter des lignes d'une liste de données répondant à des critères vers une feuille cible et d'ensuite supprimer ces mêmes lignes dans la base source. Il n'est nullement demandé, me semble t'il, de créer une liste sans doublon comme tu le fais dans la ligne 5 de ton code

Code :

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

AllRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critere,CopyToRange:=.Range("J1"), Unique:=True

Je pense également que tu n'as pas testé ton code car en ligne 3 il manque une parenthèse fermée et la syntaxe me parait curieuse.

Ici on a un filtre special mais je crois qu on peu copier que sur la même feuille c'est pour ca que je copie apres sur une autre feuille avec .value = .value

Absolument pas.
Il n'y a aucun problème pour exporter la liste vers une autre feuille. La seule restriction est pour l'utilisation manuelle du filtre avancé mais il y a une astuce voir le chapitre VII-C. Exportation vers une autre feuille que la table de données du tutoriel Les filtres avancés ou élaborés dans Excel
de plus, ce qui m'échappe
En ligne 11 tu effaces le contenu des cellules

Code :

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

AllRangeT.clearcontents

et en ligne 13, la ligne ci-dessous, ne peux plus convertir les formules par leurs valeurs puisqu'elles sont effacées

Code :

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

AllRangeT.Value = AllRange.Value

ce qui de toutes façons ne servirait à rien car les formules ne sont pas exportées dans le filtre avancés. Seul leurs résultats l'est.

[tamtam64]

Bonjour,

Bonjour,

Je souhaiterais filtrer les données de mon tableau en fonction de la valeur des cellules d'une de mes colonnes puis copier toutes les lignes relatives à ces dernières dans une autre feuille

Moi j'ai lu ca, aprés je sais pas trop mais il semblerait que ce soit résolu, mais si effectivement ca n’était pas la demande (je n'ai pas lu les autres solutions) je m'en excuse d'avance

Ma solution est un filtre en fonction d'un critère sur une colonne et qui permet de copier ces données effectivement le filtre par lui même n'est pas nécessaire. Enfin tout dépend la demande.

PS : A prioris le clearcontents ne porte que sur le range target donc vide mais peu importe puisque c'est l'endroi de la copie. Pk vouloir la formule ?

[Kiouane]

En tout cas merci pour vos réponses que j'ai lues attentivement! J'ai pu ainsi améliorer mon code.