Discussion :

[Kestion100]

* Bonjour, *

Quelqu'un peut-il me dire s'ili voit une différence entre les 2 codes suivants:

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
38
39
40
Sub PARINTERNATONLC()
 
Sheets("TABLEAU GENERAL").Select
Range("P2").Select
 
 
Do While ActiveCell.Value <> "X"
Sheets("TABLEAU GENERAL").Select
Selection.AutoFilter Field:=16, Criteria1:="A"
 
    If ActiveCell.Value Like "A" Then
        ligne = ActiveCell.Row
        Range(Cells(ligne, 1), Cells(ligne, 50)).Copy
        Sheets("A").Activate
        Range("A1").Select
        If ActiveCell.Offset(1, 0).Value = "" Then
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("TABLEAU GENERAL").Select
            ActiveCell.Offset(1, 0).Select
 
 
 
        Else
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("TABLEAU GENERAL").Select
            ActiveCell.Offset(1, 0).Select
 
        End If
 
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop
 Sheets("TABLEAU GENERAL").Select
 Range("P2").Select
Selection.AutoFilter Field:=16
End Sub

et:

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
38
39
40
Sub PARINTERNATO()
 
Sheets("OUI").Select
Range("P2").Select
 
 
Do While ActiveCell.Value <> "X"
Sheets("OUI").Select
Selection.AutoFilter Field:=16, Criteria1:="A"
 
    If ActiveCell.Value Like "A" Then
        ligne = ActiveCell.Row
        Range(Cells(ligne, 1), Cells(ligne, 50)).Copy
        Sheets("A").Activate
        Range("A1").Select
        If ActiveCell.Offset(1, 0).Value = "" Then
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("OUI").Select
            ActiveCell.Offset(1, 0).Select
 
 
 
        Else
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("OUI").Select
            ActiveCell.Offset(1, 0).Select
 
 
        End If
 
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop
 Sheets("OUI").Select
Selection.AutoFilter Field:=16
End Sub

Je mets mon "X" à la 1000ème ligne


Je m'explique:


Je voudrais filtrer les données de mon tableau selon un critère qui est la valeur d'une cellule dans une colonne, copier les lignes correspondantes et les coller dans l'onglet qui va bien

Les deux macro effectue cela.

Mon problème est que la première prends beaucoup plus de temps et, à l'écran, je vois que le filtre s'applique et que les bonnes lignes apparaissent à l'écran mais la prochaine ligne qui apparaît, en dessous de la ligne dans laquelle j'ai ma dernière valeur, est ma ligne 1001. Dans la deuxième, beaucoup plus rapide, je vois ma sélection filtrée (ligne 2 à 5, par exemple) et la prochaine ligne sera la ligne 6 dans ce cas et je vois la boucle défiler sur toutes les lignes de 6 à 1000.

J'ai l'impression que le premier code boucle sur les lignes après 1001.


Merci

[patricktoulon]

Bonjour

j'avoue que la je reste dubitatif

Code :

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

1
2
3
Selection.AutoFilter Field:=16, Criteria1:="A"
 
    If ActiveCell.Value Like "A" Then

si tu nous disais ce que tu veux en Français intelligible
on pourrait peut être t'apporter une solution

[Kestion100]

On va prendre un exemple terrestre:

J'ai un tableau qui décrit des patates, des carottes des asperges.....taille, couleur, parcel du potager d'origine.....

J'ai donc une colonne (P) dans laquelle se succèdent patate....carotte...patate....patate....asperge....carotte....

Je demande à excel de filtrer le tableau pour n'avoir que les lignes des patates, de copier ces lignes et de les coller dans l'onglet patates etc....

Le critère de filtre "A" sera donc "patate", excel balaye les lignes pour trouver ses patates, copie toute les lignes dans lesquelles il aura trouver patate (en P3....P6...P9 par exemple) et les colles dans l'onglet patate à partir de la première ligne vide.

Excel revient dans l'onglet général, cherche ses carottes.... (je n'ai pas mis ce développement, en fait, je mets la même macro à la suite et je change patate pour carotte....)

J'espère que c'est plus clair ainsi?????

[parmi]

Bonjour,

Sans voir tes tables, c'est difficile à dire, mais plutôt que de boucler toutes les lignes, intéresse-toi à
SpecialCells(xlCellTypeVisible)

Tu pourrais copier toute la plage visible d'un seul coup, après avoir mis ton filtre.

Code :

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

Range("A2:AZ" & nbLignes).SpecialCells(xlCellTypeVisible).Copy Destination

[Kestion100]

Alors j'ai fait:

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
Sub PARINTERNATONLC()
 
Sheets("TABLEAU GENERAL").Select
Range("P2").Select
 
Sheets("TABLEAU GENERAL").Select
Selection.AutoFilter Field:=16, Criteria1:="Patate"
 
           Sheets("Patate").Activate
        Range("A1").Select
       Range("A2:AZ" & 100).SpecialCells(xlCellTypeVisible).Copy Destination
 Sheets("TABLEAU GENERAL").Select
 Range("P2").Select
Selection.AutoFilter Field:=16
End Sub

Et j'ai l'erreur:

Erreur d'exécution '1004':
La méthode Copy de la classe Range a échoué

Avec la ligne:

Code :

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

 Range("A2:AZ" & 100).SpecialCells(xlCellTypeVisible).Copy Destination

en surbrillance

Je tente:

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 PARINTERNATONLC()
 
Sheets("TABLEAU GENERAL").Select
Range("P2").Select
 
Sheets("TABLEAU GENERAL").Select
Selection.AutoFilter Field:=16, Criteria1:="Patate"
Range("A1").Select
       Range("A2:AZ" & 100).SpecialCells(xlCellTypeVisible).Copy Destination
 
        Sheets("Patate").Activate
     ActiveSheet.Paste
 Sheets("TABLEAU GENERAL").Select
 Range("P2").Select
Selection.AutoFilter Field:=16
End Sub

Pareil

[parmi]

Change Destination par le nom de la feuille et la cellule en A où tu veux copier.

Code :

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

1
2
3
 
Ligne = Sheets("Patates").Cells(Rows.Count, "A").end(xlup).row + 1
Range("A2:AZ" & 100).SpecialCells(xlCellTypeVisible).Copy Sheets("Patates").Range("A" & Ligne)

[Kestion100]

J'ai arrangé comme ça mais toujours rien

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
Sub PARINTERNATONLC()
 
Sheets("TABLEAU GENERAL").Select
Range("P2").Select
 
 
 
Sheets("TABLEAU GENERAL").Select
Selection.AutoFilter Field:=16, Criteria1:="Patate"
Range("A1").Select
       Range(Cells(ligne, 1), Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy Sheets("Patate").ActiveCell.Offset(1, 0).Select.Paste
 
 
 
        Sheets("TABLEAU GENERAL").Select
 Range("P2").Select
Selection.AutoFilter Field:=16
End Sub

[Kestion100]

Excel ne veut rien entendre dès la première ligne:

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
Sub PARINTERNATONLC()
 
Sheets("TABLEAU GENERAL").Select
Range("P2").Select
 
Sheets("TABLEAU GENERAL").Select
Selection.AutoFilter Field:=16, Criteria1:="Patate"
Range("A1").Select
      Ligne = Sheets("Patate").Cells(Rows.Count, "A2").End(xlUp).Row + 1
      Range("A2:AZ" & 100).SpecialCells(xlCellTypeVisible).Copy Sheets("Patate").Range("A2" & 100)
 
 Sheets("TABLEAU GENERAL").Select
 Range("P2").Select
Selection.AutoFilter Field:=16
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub PARINTERNATONLC()
 
Sheets("TABLEAU GENERAL").Select
Range("P2").Select
 
Sheets("TABLEAU GENERAL").Select
Selection.AutoFilter Field:=16, Criteria1:="Patate"
Range("A1").Select
     Range("A2:AZ" & 100).SpecialCells(xlCellTypeVisible).Copy Sheets("Patate")
 
 Sheets("TABLEAU GENERAL").Select
 Range("P2").Select
Selection.AutoFilter Field:=16
End Sub

N'y fait rien