[ Resolu par Job75,Merci ] Sauvegarder les lignes contenant un mot bien precis

  • Initiateur de la discussion Initiateur de la discussion Guido
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Guido

XLDnaute Accro
Bonsoir le Forum

Je recherche une macro qui efface le contenu des lignes inferieurs de la ligne, ou des lignes

qui comprend le mot FAV.... qui se trouve dans la colonne C et ceci dans les 9 plages

que comprend la feuilles.

Ensuite pour évité un 2em post ,j'aimerais dans la plage en dessous garder que les

colonnes qui comportent le n° qui se trouve avant le mot FAV....

Ci joint une page du fichier

avec les plages a garder ainsi que les colonnes a garder.

A plus

Guido
 

Pièces jointes

Re,

Notez que si les "FAV" ne sont pas toujours groupés en tête il suffit de les regrouper :
Code:
Sub Favoris()
Dim w As Worksheet, c As Range, n%, p As Byte, c1 As Range, col As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
  If LCase(Right(w.Name, 3)) = "bis" Then w.Delete 'RAZ
Next
For Each w In Worksheets
  If w.[A1] Like "R#*C#*" Then
    w.Visible = xlSheetVisible 'si la feuille a été masquée
    w.Copy After:=w
    ActiveSheet.Name = w.Name & " BIS"
    For Each c In [A:A].SpecialCells(xlCellTypeConstants, 2)
      n = Application.CountIf(c(6, 3).Resize(20), "*FAV*")
      If n < 20 Then
        p = 0
        For Each c1 In c(6, 3).Resize(20)
          If LCase(c1) Like "*fav*" Then
            p = p + 1
            c1(1, 0).Resize(, 23).Copy c(5 + p, 2) 'regroupe les "FAV" en tête
            If p = n Then Exit For
          End If
        Next c1
        c(25).Resize(, 25) = "" 'effacement de la dernière ligne
        c(25).Resize(, 25).Copy c(6 + n).Resize(20 - n, 25)
      End If
      p = 0
      For n = n To 1 Step -1
        col = Application.Match(c(5 + n, 2), c(27).Resize(, 11), 0)
        If IsNumeric(col) Then
          p = p + 1
          c(27, col).Resize(12).Cut
          c(27, 3).Insert xlToRight
        End If
      Next n
      c(27, 12).Resize(12).Copy c(27, p + 3).Resize(12, 10 - p) 'pour la couleur
    Next c
  End If
Next w
Feuil6.Activate 'CodeName de la feuille "Accueil"
End Sub
Fichier (2 bis) avec les "FAV" de la 1ère course non groupés..

A+
 

Pièces jointes

Re

Merci Job75.

Je me permet de te demander une chose que tu connais déjà .

Serait il possible d'avoir le nombres total de couleurs vertes foncées des chx Fav

en horizontal et verticales, je me répète que pour les Fav de se fichier

Merci,Job75

Bon app...

a plus

Guido
 
Re

Bonsoir Job75 et le Forum

Merci pour le dernier fichier ,Il me convient très bien

je vais déplacer les cellules qui concernent le total des cellules vertes qui font référence

aux chx verticaux et les faire afficher a cotés des citations horizontales avec le

classement totale par citations .

Je vais me basés sur un modèle fait par Job75.

Je vous redis ce soir .

Merci

Guido
 
Bonjour Guido, le forum,
je vais déplacer les cellules qui concernent le total des cellules vertes qui font référence

aux chx verticaux et les faire afficher a cotés des citations horizontales avec le

classement totale par citations .
J'ai donc mis le tableau des résultats en colonnes AA:AD des feuilles "BIS" et revu la macro en conséquence.

Fichier (4).

Bonne journée.
 

Pièces jointes

Bonsoir ChTi160 et le Forum

Je te remercie pour le fichier. Mais quand j'essaie de faire fonctionner les boutons...

il sont inactifs ?? J'ai même renommer le fichier,domage j'aurais bien aimer voir ton travail..

Je suis sur 2003. ??

A bientôt

Amitiés

Guido
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour