[VBA] Copier les 5 premières lignes après un Filtre

marsboul2d

XLDnaute Nouveau
Bonjour à tous !

J'ai réalisé une Macro à l'aide d'un enregistrement. Dans cette macro, je copie les 5 premières lignes d'un tableau dans lequel j'applique un filtre. Mon problème : les données du tableau change d'une semaine à l'autre, ainsi lorsque j'applique mon filtre en Semaine 1, les 5 premières ligne que je veux copier sont dans le rectangle C4:J14 (correspond aux ligne 4,7,10,11,14). En semaine 2 ces lignes pourraient être totalement différentes. Ainsi, lorsque j'applique ma Macro, au lieu de me sortir les 5 premier résultat, il me sort les 3 premiers seulement. Comment faire pour copier les 5 premières lignes en omettant les lignes cachées ?


Code:
 ActiveSheet.Range("$A$2:$J$253").AutoFilter Field:=8, Criteria1:=">10", _
        Operator:=xlAnd
    ActiveWindow.SmallScroll Down:=-3
    Range("C4:J14").Select
    Selection.Copy
    Sheets("Semaine - Stats").Select
    Range("A6").Select

Merci pour votre retour :)
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : [VBA] Copier les 5 premières lignes après un Filtre

Bonjour Marsboul, bonjour le forum,

en pièce jointe un petit exemple (vu que tu n'as pas daigné le fournir toi-même) avec le code commenté ci-dessous, que tu devras adapter à ton cas :
Le code :

Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)

Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A2:A" & DL) 'définit la plage PL
O.Range("A1").AutoFilter Field:=3, Criteria1:=1 'filtre la colonne 1 (=A) de l'onglet O avec 3 comme critère
Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visible (non filtrée) de PL
'colle la première cellule de la plage PLV (en redimensionnant à 5 lignes et 2 colonnes (tu adpteras à ton cas) colonnes)
PLV(1).Resize(5, 2).Copy Sheets("Feuil2").Range("A1")
O.Range("A1").AutoFilter 'supprime le filtre automatique
End Sub
Le fichier :
 

Pièces jointes

  • Marsboul_v01.xlsm
    18.2 KB · Affichages: 116

Discussions similaires

Statistiques des forums

Discussions
311 726
Messages
2 081 955
Membres
101 852
dernier inscrit
dthi16088