XL 2016 Rechercher un mot dans une colonne et copier coller les lignes dans une autre feuille excel

broking

XLDnaute Nouveau
Bonjour,

J'aimerais que les mots "non conforme"et sa ligne soit copié et collé dans un autre tableau excel ainsi que les 10 lignes qui suivent
 

Pièces jointes

  • test.xlsx
    9.8 KB · Affichages: 11

xUpsilon

XLDnaute Accro
Je reprends mon programme plus tard pour te faire ça. Y a t'il un intervalle précis de lignes que tu souhaites entre les séries de données ?
Pour utiliser le plus efficacement possible excel, le plus simple serait de tout avoir à la suite (autant dans les données de la première feuille que dans les données de la deuxième.
 

job75

XLDnaute Barbatruc
Bonjour broking, Robert, xUpsilon, le forum,

Je vois que dans la feuille "non conforme" du fichier post #16 chaque groupe de données fait 13 et 14 lignes.

Alors que précédemment vous parliez de limiter à 11 lignes, que voulez-vous exactement ?

Bonne journée.
 

broking

XLDnaute Nouveau
Bonjour broking, Robert, xUpsilon, le forum,

Je vois que dans la feuille "non conforme" du fichier post #16 chaque groupe de données fait 13 et 14 lignes.

Alors que précédemment vous parliez de limiter à 11 lignes, que voulez-vous exactement ?

Bonne journée.
Alors enfaîte quand j'aurais un non conforme le but c'est de sélectionner les 10 qui suivent derrière la non conformité pour que je puisse voir si mes gobelets respecte les normes de grammage et donc suite a la non conformité je pourrais voir quelle séries de gobelet est conforme ou non.
 

job75

XLDnaute Barbatruc
Donc on limite la copie à un maximum de 11 lignes, voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Activate()
Dim txt$, Nmax&, deb As Range, c As Range, lig&, h&
txt = "non conforme" 'texte à rechercher
Nmax = 11 'nombre maximum de lignes copiées, à adapter
Application.ScreenUpdating = False
Rows(3).Resize(Rows.Count - 2).Delete 'RAZ
With Sheets("Sheet1") 'à adapter
    Set deb = .Cells.Find(txt, , xlValues, xlWhole)
    If deb Is Nothing Then Exit Sub
    Set c = deb
    lig = 3
    Do
        h = c.EntireRow.CurrentRegion.Rows.Count
        If h > Nmax Then h = Nmax
        .Rows(c.Row).Resize(h).Copy Cells(lig, 1)
        Set c = .Cells.Find(txt, c)
        lig = lig + h + 1 '1 ligne de séparation
    Loop While c.Row > deb.Row
End With
End Sub
 

Pièces jointes

  • test(1).xlsm
    18.8 KB · Affichages: 7

broking

XLDnaute Nouveau
Donc on limite la copie à un maximum de 11 lignes, voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Activate()
Dim txt$, Nmax&, deb As Range, c As Range, lig&, h&
txt = "non conforme" 'texte à rechercher
Nmax = 11 'nombre maximum de lignes copiées, à adapter
Application.ScreenUpdating = False
Rows(3).Resize(Rows.Count - 2).Delete 'RAZ
With Sheets("Sheet1") 'à adapter
    Set deb = .Cells.Find(txt, , xlValues, xlWhole)
    If deb Is Nothing Then Exit Sub
    Set c = deb
    lig = 3
    Do
        h = c.EntireRow.CurrentRegion.Rows.Count
        If h > Nmax Then h = Nmax
        .Rows(c.Row).Resize(h).Copy Cells(lig, 1)
        Set c = .Cells.Find(txt, c)
        lig = lig + h + 1 '1 ligne de séparation
    Loop While c.Row > deb.Row
End With
End Sub
c'est pile se qui me fallait encore merci !!
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 329
Messages
2 087 335
Membres
103 520
dernier inscrit
Azise