Boucle sur filtre

Bonjour à tous,

La macro ci-dessous bloque "Next sans For".

Pourriez-vous me dire où la syntaxe ne va pas ?

J'explique le but de cette macro. Je souhaite qu'un filtre se mette en place sur la feuille5 et que pour chaque valeur filtrée en A celle ci se copie.

Par exemple :

Pour i = 21 alors il filtre les données où A=21 puis me copie toute la plage et la colle à partir de la cellule nommée TAB_21 (Sur une autre feuille du meme classeur)

Sub Macro1()
Dim i As Integer
With Worksheets("Feuil5")
For i = 21 To 28
    Range("A3:T3").Select
    Selection.AutoFilter
    Range("A3").Select
    ActiveSheet.Range("$A$3:$T$15").AutoFilter Field:=1, Criteria1:=i
   If Range("a4") = "" Then Next

   Else
   Range("J4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
   Application.Goto Reference:="TAB_" & i
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Next
   End If
   End With
End Sub

Merci beaucoup

Bonjour,

Les instructions "Select" sont à proscrire, étant parfaitement inutiles tant que les objets sur lesquels tu travailles sont systématiquement précisés. Par exemple :

Range("A3:T3").Select
Selection.AutoFilter
'S'écrit :
Range("A3:T3").AutoFilter

L'utilisation d'une instruction "With" est très utile, encore faudrait-il qu'elle soit utilisée (mettre un "." devant les objets en question) ! Cela t'évite de répéter un nom d'objet plusieurs fois, par exemple :

Worksheets("Feuil5").Range("A3:T3").Machin
Worksheets("Feuil5").Range("A3").Truc
Worksheets("Feuil5").Range("$A$3:$T$15").Bidule
'Devient :
With Worksheets("Feuil5")
   .Range("A3:T3").Machin
   .Range("A3").Truc
   .Range("$A$3:$T$15").Bidule
End With

Next s'utilise principalement dans le cadre d'une structure en boucle, comme :

For i = Bidule To Machin
   'Série d'instructions
Next i

Mais il ne doit apparaître qu'une seule fois par boucle, et pas au hasard de la progression dans le code. Si tu ne souhaites rien faire quand A4 est vide, il faut plutôt écrire :

If Not Range("A4") = "" Then
   'Instructions
End If

Ou encore :

If Not IsEmpty(Range("A4")) Then
   'Instructions
End If

Merci pour toutes ces précisions. J'en prends note.

Par contre cela ne solutionne pas mon problème....

as tu une idée ?

jahman a écrit :

Merci pour toutes ces précisions. J'en prends note.

Par contre cela ne solutionne pas mon problème....

as tu une idée ?

Ma réponse fait plus que ça ! Si tu as lu jusqu'au bout, j'ai précisé d'où vient ton erreur "Next sans For". C'est cette instruction qui pose problème (car cette syntaxe n'est pas la bonne) :

If Range("a4") = "" Then Next

j'ai apporté les corrections :

Sub Macro1()
Dim i As Integer
With Worksheets("Feuil5")
For i = 21 To 28
    Range("A3:T3").AutoFilter

    ActiveSheet.Range("$A$3:$T$15").AutoFilter Field:=1, Criteria1:=i
   If Not Range("a4") = "" Then
   Range("J4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
   Application.Goto Reference:="TAB_" & i
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Next i
   End If
   End With
End Sub

Néanmoins cela ne fonctionne pas. le "i" apparait pour le critère du filtre (je sai spas si on peut) et pour le nom de la plage nommée.

Ton écriture est plus correcte, mais là je crois que c'est l'explication de ton problème qui n'est pas claire !

Petit rappel, je ne sais ni quel est le but exact de ta macro, ni sur quel fichier tu travailles (qu'est ce qu'il contient, où sont les données). Avant de te lancer dans des explications, saches qu'un bon fichier illustratif vaut parfois tous les mots !

Si je comprends bien, tu ne souhaite travailler que sur les lignes issues d'un filtre. Aussi, un filtre ne fait que modifier l'affichage, les lignes qui ne remplissent pas les conditions, bien qu'elles ne soient pas affichées à l'écran, sont toujours présentes et peuvent être parcourues en macro.

Pour identifier si la ligne est filtrée, on utilise une instruction du type : .SpecialCells(xlCellTypeVisible)

Ci-joint un fichier simplifié.

Merci de ton aide

Je souhaite que chaque ligne qui commence par 21 soit copiées à partir de la cellule nommée TAB_21, ligne commencant par 22 copiées à partir de TAB_22, etc

A savoir, dan sle fichier origine, les onglets 21,22,.... portent un autre nom :-/

Ah oui, et aussi qu'elle se copie jusqu'à la colonne J

Une proposition :

Sub Macro1()

Dim i As Integer, DerLig As Long, Lig As Long

With Worksheets("Feuil5")
    DerLig = .Range("A" & .Rows.Count).End(xlUp).Row 'Identifie la dernière ligne
    For i = 21 To 28
        For Lig = 4 To DerLig 'Parcourt les lignes
            If .Range("A" & Lig) = i Then 'Si valeur en A = i
                .Range("A" & Lig & ":J" & Lig).Copy 'Copie la ligne jusqu'en colonne J
                Application.Goto Reference:="TAB_" & i 'Trouve la plage nommée correspondante
                Selection.PasteSpecial Paste:=xlPasteValues 'Colle en valeur
                Application.CutCopyMode = False 'Décharge la zone copiée de la mémoire
            End If
        Next Lig
   Next i
End With

End Sub

Merci, pour ta proposition. Juste, il me copie que la dernière ligne de chaque i.

Il doit remplacer a chaque fois la ligne au lieu de copier toutes les lignes d'un coup.

Effectivement ! Voilà une version qui en tient compte :

Sub Macro1()

Dim i As Integer, DerLig As Long, Lig As Long, n As Integer

With Worksheets("Feuil5")
    DerLig = .Range("A" & .Rows.Count).End(xlUp).Row 'Identifie la dernière ligne
    For i = 21 To 28
        n = 0
        For Lig = 4 To DerLig 'Parcourt les lignes
            If .Range("A" & Lig) = i Then 'Si valeur en A = i
                .Range("A" & Lig & ":J" & Lig).Copy 'Copie la ligne jusqu'en colonne J
                Application.Goto Reference:="TAB_" & i 'Trouve la plage nommée correspondante
                Selection.Offset(n, 0).PasteSpecial Paste:=xlPasteValues 'Colle en valeur
                Application.CutCopyMode = False 'Décharge la zone copiée de la mémoire
                n = n + 1
            End If
        Next Lig
   Next i
End With

End Sub

IMPECCABLE !!! ca fonctionne du feu de Dieu !!!!

Un énorme merci à toi, ma macro a perdu 70 lignes d'un coup