selectionner les 4 premières lignes apres filtre

[ashiles]

bonjour le forum
ca fait plusieurs semaines que je bloque sur un fichier que j'ai bientot fini, grace à toutes les discussions sur ce forum.
je voudrais copier les 4 premières lignes visibles apres un filtre, cas N° 1, et cas N° 2 les les 4 suivantes .

voici le code que j'ai mis:

Sub user()


Selection.AutoFilter Field:=1, Criteria1:="1"
Range("A2:" & [a1].SpecialCells(xlCellTypeLastCell).Address).copy


End Sub
merci beaucoup par avance

 

[ashiles]

Re : selectionner les 4 premières lignes apres filtre

re,

Sub user()

Sheets("feuil1").Range("A1:e100").AutoFilter Field:=1, Criteria1:=1
Range("A2:" & [a1].SpecialCells(xlCellTypeLastCell).Address).Copy


End Sub

j'ai modifié le coe sans succes, ca fait copier la totalité de la plage visible, hepl!!!

 

[ashiles]

Re : selectionner les 4 premières lignes apres filtre

y a t'il qq qui peut m'aider svp?

 

[mapomme]

Re : selectionner les 4 premières lignes apres filtre

Bonsoir ashiles,

Une variation sur le thème...
Filtre sur colonne A, copie des quatre 1ière lignes filtrées (colonne B) vers la cellule D30.

Sub CopierVers()
Dim V As Range, xArea, QuatreVal(1 To 4), i As Long, N As Long

Range("A1:A25").AutoFilter Field:=1, Criteria1:="1"

Set V = Range(Cells(2, "a"), Cells(2, "a").End(xlDown)).SpecialCells(xlCellTypeVisible).Offset(, 1)

For Each xArea In V.Areas
   For i = 1 To xArea.Rows.Count
      N = N + 1
      QuatreVal(N) = xArea(i).Value
      If N = 4 Then Exit For
   Next i
   If N = 4 Then Exit For
Next xArea
Range("D30").Resize(4).ClearContents
Range("D30").Resize(N) = Application.Transpose(QuatreVal)
End Sub

 

[ashiles]

Re : selectionner les 4 premières lignes apres filtre

bonjour mapomme
merci infiniment c'est exactement je que je voudrais, mon tableau comprend plusieurs colonnes que je dois copier et non seulement la colonne B, excuses moi car je suis débutant mais je ne sais pas comment modifier le code
encore merci

 

[ashiles]

Re : selectionner les 4 premières lignes apres filtre

re-bonjour

pour plus de précision, j'ai un fichier avec 5 feuilles avec les memes entetes de colonnes, sur lesquelles j'applique un filtre sur toutes les feuilles simultanément, jusque là tout va bien, pour finaliser sur une feuille que j'ai appelé "windows" je voudrais copier les 4 premières lignes des 5 feuilles et les coller en A2, A6, A10 et A14 de la feuille "windows" dans le cas N° 1, dans le cas N° 2 copier les lignes 5 à 8 les copier dans les mêmes cellules.

 

[mapomme]

Re : selectionner les 4 premières lignes apres filtre

Bonjour ashiles,

J'ai essayé de créer une procédure avec paramètres qui doit permettre :

• à partir de n'importe quelle feuille du classeur et où que soit situé le tableau filtré dans cette feuille
• de copier un nombre variable de lignes filtrées (visibles) à partir de la Nième ligne visible
• et de copier un nombre variable de colonnes (à partir de la première colonne) en incluant ou non la première colonne
• vers n'importe quelle cellule de n'importe quelle feuille du classeur.

A partir de là, vous devriez trouver votre bonheur.

Ce qui doit être fait en dehors de cette procédure:

• effacer la zone destination
• inscrire les en-têtes dans la feuille destination
• filtrer chaque tableau

Les commentaires doivent permettre de comprendre l'utilisation et le fonctionnement de la procédure.

Voir utilsation dans fichier joint.

Sub CopierFiltre(DeLaFeuille As String, CoinSupGaucheFiltre As String, _
      NLignes As Long, ApartirLigne As Long, Ncolonnes As Long, _
      Exclure1iereCol As Boolean, VersFeuille As String, VersCellule As String)
      
      
' paramètres:
' DeLaFeuille : nom dela feuille qui contient le filtre
' CoinSupGaucheFiltre : adresse de 1ère cellule du filtre en-têtes compris
' Nlignes : nombre de lignes filtrée à copier
' ApartirLigne : numero relatif de ligne à partir de laquelle on commence la copie
'        ex: si ApartirLigne = 3 => on saute les deux premières lignes filtrées
'        pour commencer la copie à 3 ième ligne des lignes visibles.
' Ncolonnes : nombre de colonnes à copier Y COMPRIS LA 1 IERE COLONNE !!!
' Exclure1iereCol :  si FALSE, on copie aussi la 1ière colonne
'                            si TRUE, on ne copie pas la 1 ière colonne
' VersFeuille : nom de la feuille destination
' VesrCellule : adresse de la cellule de destination.

           
Dim V As Range, xArea As Range, i As Long, j As Long, N As Long
Dim DebutColFiltre As Long, DebutLigFiltre As Long, DerLig As Long
Dim NbrColCopier As Long, SauteLigne As Long

With Sheets(DeLaFeuille)
   'Première colonne du filtre
   DebutColFiltre = .Range(CoinSupGaucheFiltre).Column
   'Première ligne des données du filtre
   DebutLigFiltre = .Range(CoinSupGaucheFiltre).Row
   'Dernière ligne filtrée visible
   DerLig = .Cells(.Cells.Rows.Count, DebutColFiltre).End(xlUp).Row
   'si aucune ligne visible ==> on ne fait rien
   If DerLig <= DebutLigFiltre Then Exit Sub
   'Range des cellules visibles à partir de la colonne DebutLigFiltre sur Ncolonnes
   '1ière colonne (celle du filtre incluse)(ligne en-têtes exclue)
   Set V = .Range(.Cells(DebutLigFiltre + 1, DebutColFiltre), .Cells(DerLig, DebutColFiltre))
   If Exclure1iereCol Then
      'On ne copie pas la 1ière colonne du filtre
      NbrColCopier = Ncolonnes - 1
      Set V = V.Offset(, 1).Resize(, NbrColCopier)
   Else
      'On copie aussi la 1ière colonne du filtre
      NbrColCopier = Ncolonnes
      Set V = V.Resize(, NbrColCopier)
   End If
   'On ne retient que les cellules visibles
   Set V = V.SpecialCells(xlCellTypeVisible)
End With ' Sheets(DeLaFeuille)

'Déclaration du tableau résultat
ReDim TabResult(1 To NLignes, 1 To NbrColCopier)

'boucle sur les zones de V
N = 0: SauteLigne = 0
For Each xArea In V.Areas
   'boucle sur les lignes d'une zone
   For i = 1 To xArea.Rows.Count
      'comptage lignes à sauter
      SauteLigne = SauteLigne + 1
      'Si plus de ligne à sauter => on traite
      If SauteLigne >= ApartirLigne Then
         'incrémentation d'une ligne du tableau résultat
         N = N + 1
         'si on est au moins à la 1ière ligne à copier
         ' alors Remplissage d'une ligne
         For j = 1 To NbrColCopier
            TabResult(N, j) = xArea(i, j).Value
         Next j
      End If
      'si le nbre de lignes à copier a été atteint
      If N = NLignes Then Exit For 'indice i
   Next i
'si le nbre de lignes à copier a été atteint
If N = NLignes Then Exit For 'indice xArea
Next xArea

'Copie vers la feuille et cellule destination
Sheets(VersFeuille).Range(VersCellule).Resize(NLignes, NbrColCopier).Value = TabResult
         
End Sub

Sub TEST()
Sheets("windows").Range("A1:D" & Rows.Count).ClearContents
Sheets("1").Range("A1:D1").Copy Sheets("windows").Range("A1:D1")

Sheets("1").Range("A:A").AutoFilter Field:=1, Criteria1:="1"
CopierFiltre DeLaFeuille:="1", CoinSupGaucheFiltre:="A1", NLignes:=2, _
   ApartirLigne:=3, Ncolonnes:=4, Exclure1iereCol:=False, _
   VersFeuille:="windows", VersCellule:="A2"

Sheets("2").Range("B:B").AutoFilter Field:=1, Criteria1:="1"
CopierFiltre DeLaFeuille:="2", CoinSupGaucheFiltre:="B1", NLignes:=3, _
   ApartirLigne:=1, Ncolonnes:=4, Exclure1iereCol:=False, _
   VersFeuille:="windows", VersCellule:="A6"
   
Sheets("3").Range("G3:J1000").AutoFilter Field:=1, Criteria1:="1"
CopierFiltre DeLaFeuille:="3", CoinSupGaucheFiltre:="G3", NLignes:=2, _
   ApartirLigne:=1, Ncolonnes:=4, Exclure1iereCol:=False, _
   VersFeuille:="windows", VersCellule:="A10"
   
'Exemple : Le filtre ne renvoie aucune ligne
Sheets("4").Range("A:A").AutoFilter Field:=1, Criteria1:="99999"
CopierFiltre DeLaFeuille:="4", CoinSupGaucheFiltre:="A1", NLignes:=4, _
   ApartirLigne:=1, Ncolonnes:=4, Exclure1iereCol:=False, _
   VersFeuille:="windows", VersCellule:="A14"
End Sub

 

[ashiles]

Re : selectionner les 4 premières lignes apres filtre

Bonsoir Mapomme

je ne trouve pas de mots pour vous remercier, c'est exactement ce que je voulais.

merci infiniment