XL 2013 selection les 5 premieres lignes visible apres filtre VBA

FlamXYZ

XLDnaute Nouveau
Salut a tous,
j'ai un tableau de 3 colonnes : ville, produit, montant
Le tableau represente une liste de produit disponible par ville ayant des montants différents.
je voudrai récupérer les valeurs de la ville et du montant des 5 premieres lignes visibles après avoir filtrer sur un produit.

la difficulté est que la premiere ligne visible apres la ligne de l'entête peut etre la ligne N°39, la seconde pourrait etre la ligne N°400 etc...
Le code :
range(range("C1").range("C1").offset(5,0).select ne selectionne pas les cellules visibles, mais celles qui sont masqué.
Pourriez m'aider svp ?
merci d'avance
 

eriiic

XLDnaute Barbatruc
Bonjour,

VB:
Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
l'élément important est .SpecialCells(xlCellTypeVisible)
Tu peux mettre un traitement d'erreur si la sélection peut être vide.
Ici tout est copié, tu peux ajouter un .Resize(5) au bout.
eric
 

job75

XLDnaute Barbatruc
Bonjour FlamXYZ, eriiic,

Voyez le fichier joint et cette macro :
VB:
Sub Recuperer_filtre()
Dim i&, n&, a(1 To 5, 1 To 2)
With [A1].CurrentRegion
    For i = 2 To .Rows.Count
        If Not .Rows(i).Hidden Then
            n = n + 1
            a(n, 1) = .Cells(i, 1)
            a(n, 2) = .Cells(i, 3)
            If n = 5 Then Exit For
        End If
    Next
    '---restitution éventuelle sous le tableau---
    With .Cells(.Rows.Count + 2, 1)
        If n Then .Resize(n, 2) = a
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ dessous
    End With
End With
End Sub
A+
 

Pièces jointes

  • Récupérer filtre(1).xlsm
    18.6 KB · Affichages: 10

job75

XLDnaute Barbatruc
Si l'on ne veut pas récupérer les données dans un tableau VBA on peut faire autrement :
VB:
Sub Recuperer_filtre()
Application.ScreenUpdating = False
With [A1].CurrentRegion.Resize(, 3)
    .Offset(.Rows.Count).Resize(Rows.Count - .Rows.Count, 3).Delete xlUp 'RAZ en dessous
    .Copy .Cells(.Rows.Count + 2, 1) 'copier-coller
    With .Cells(.Rows.Count + 2, 1).CurrentRegion
        .Columns(3).Cut .Columns(2) 'couper-coller pour supprimer une colonne
        If .Rows.Count > 6 Then .Offset(6).Resize(.Rows.Count - 6, 2).Delete xlUp 'RAZ apès la 6ème ligne
    End With
End With
End Sub
 

Pièces jointes

  • Récupérer filtre(2).xlsm
    18.7 KB · Affichages: 10

Discussions similaires

Statistiques des forums

Discussions
312 038
Messages
2 084 822
Membres
102 680
dernier inscrit
naddad