XL 2013 Extraction lignes selon condition

steven542304

XLDnaute Nouveau
Bonjouuuuuuur,

J'ai besoin d'un coup de main.

J'ai un classeur qui se compose d'une page d'accueil, ainsi que d'autres feuilles à la structure identique. (Une feuille par mois)

Dans la colonne H de chacune des feuilles, j'ai une MFC qui indique "à relancer" si le délai de 30 jours est dépassé.

Pour faciliter la tâche, j'aimerai que les lignes où la colonne H contient "à relancer" soit extraite vers ma feuille d'accueil. Et cela automatiquement et pour toutes feuilles.

Si quelqu'un à une piste, avec VBA de préférence, je suis preneur...

En cherchant j'ai vu qu'on pouvait faire ça avec des filtres,

Un grand merci par avance,
 

Matheop

XLDnaute Occasionnel
Bonjour steven, le forum.

Je te propose la macro suivante, assez basique et répondant (je l'espère) à ton besoin.


VB:
Sub extract()
    Dim feuil As Worksheet
    Dim nbLignes As Integer
    ' récupération nombre lignes non vides (en se basant sur la colonne H) 
    ' dans la page d'accueil pour extraire à partir de la ligne suivante
    nbLignes = Sheets("Accueil").Range("H1048576").End(xlUp).Row
   
    Dim lastLigneFeuil As Integer
    Dim plageCellules As Range
    Dim trig As Integer
    trig = 0
   
    ' boucle sur chaque feuille du classeur hors mis la feuille d'accueil
    For Each feuil In ThisWorkbook.Sheets
        If Not feuil.Name = "Accueil" Then
            ' récupération de la dernière ligne non vide de la feuille scannée (en se basant sur la colonne H)
            lastLigneFeuil = feuil.Range("H1048576").End(xlUp).Row

            ' boucle allant de 1 jusqu'à la dernière ligne non vide de la feuille scannée
            For x = 1 To lastLigneFeuil
                ' si la cellule en H1 ... Hx contient la valeur "A relancer"
                ' alors on copie la ligne entière dans la prochaine ligne vide de la page d'accueil
                If feuil.Cells(x, 8).Value = "A relancer" Then
                    feuil.Cells(x, 8).EntireRow.Copy Destination:=Sheets("Accueil").Cells(nbLignes + 1, 1).Offset(trig, 0).EntireRow
                    trig = trig + 1
                End If
            Next
        End If
    Next feuil

End Sub

Je viens de tester sur un classeur, ça fonctionne plutôt bien. Il faut bien sûr adapter le code selon tes envies, besoins.

A bientôt,
 

Slakhdine

XLDnaute Nouveau
bonjour a tous. j'ai un soucis pareil mais pour moi je souhaite copier les lignes dont la cellule T est vide vers un autre fichier que je souhaite créer qui s'appel wb_sms_non_envoyes . je serai très reconnaissant si vous pourriez m'aider
voici mon code qui marche pas :
VB:
Sub extract()

    Dim wb_sms_non_envoyes As Workbook
    Dim nbLignes As Integer
    Dim trig As Integer
    
    ' récupération nombre lignes non vides
    ' dans la page DATA pour extraire à partir de la ligne suivante
    nbLignes = Sheets("DATA").Range("T104").End(xlUp).Row
    
       Set wb_sms_non_envoyes = Workbooks.Add
      
    With wb_sms_non_envoyes
    .SaveAs Filename:=wb.Path & "wb_sms_non_envoyes" & ".xlsx"
    
    End With
    
    trig = 0
            ' boucle allant de 1 jusqu'à la dernière ligne non vide de la feuille DATA
            For x = 1 To nbLignes
                ' si la cellule en T1 ... Tx est vide
                ' alors on copie la ligne entière dans le fichier wb_sms_non_envoyes
                If Sheets("DATA").Cells(x, 20).Value = "" Then
                    Sheets("DATA").Cells(x, 20).EntireRow.Copy Destination:=wb_sms_non_envoyes("Feuille1").Cells(nbLignes + 1, 1).Offset(trig, 0).EntireRow
                    trig = trig + 1
                End If
            Next x

End Sub
 

themyse1

XLDnaute Nouveau
Bonjour,

j'ai un fichier très volumineux qui qui est agrémenté automatiquement. j'aimerais extraire de ce tableau, exclusivement les ligne qui me concernent .

je me suis inspiré du code de MatiChoux mais il doit y avoir un truc que je fait mal parce que ça ne fonctionne pas. ici dans mon classeur d'exemple j'aimerais extraire toute les ligne qui concerne Toto.

Merci de votre aide
 

Pièces jointes

  • Toto.xlsm
    20.9 KB · Affichages: 5

Discussions similaires

Réponses
4
Affichages
277

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla