comme dans mon test.xlsxoui exactement apres il y aura aussi des "conforme" du coup je n'aimerais avoir que les "non conforme" dans la feuille des "non conforme" et donc ne pas recopié a chaque fois les "non conforme" déjà inscrit
(qui est sans macro j'ai fais manuellement pour voir ce que je veux réellement)comme dans mon test.xlsx
tu es toujours up ?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.
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.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.
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 !!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