Copier/coller certaines lignes en fonction d'un critère

Bonjour !

Je cherche à copier des lignes dans plusieurs onglets (celles pour lesquelles la colonne "problèmes" est remplie) et les coller dans un onglet récapitulatif.

J'y arrive plus ou moins, il me manque juste la formule magique pour coller dans la dernière ligne de mon tableau récapitulatif, en effet, pour l'instant, j’écrase le contenu de ma cellule pour ré-écrire dessus alors que j'aimerais que si la ligne est remplie, écrire sur la ligne du dessous...

J'ai essayé de faire un do until, mais je ne maitrise pas bien...

Merci d'avance pour votre aide !

84esa.xlsm (152.50 Ko)

Bonjour,

Tout d'abord, le fichier est protégé par un mot de passe. On ne peut donc pas y accéder. Pourrais-tu le renvoyer sans mot de passe ?

En attendant, trouver la dernière ligne non vide ne réclame pas de boucle.

il suffit de mettre le code correspondant:

'en partant du haut du tableau --> descendre en bas (si pas de celule vide entre les 2 dans la colonne A ici
Sheets("Feuil1").range("A1").end(XLdown).offset(1,0).select 'selection de la première cellule vide
'en partant du bas de la feuille (dernière cellule en cas de cellules vides dans le tableau)
Sheets("Feuil1").range("A"& rows.count).end(XLup).offset(1,0).select

Ps : pour éviter les select, ceux ci peuvent être remplacés par PasteSpecial

Cordialement

Bonjour le fil, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim WS As Worksheet 'déclare la variable WS (WorkSheet)
Dim R As Worksheet 'déclare la variable R (Recapmois)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Integer 'déclare la variable I (Incrément)

Set R = Worksheets("Recapmois") 'définit l'onglet R
R.Rows("18:" & Application.Rows.Count).Delete 'supprime les lignes de 18 à la dernières de l'onglet R
For Each WS In Worksheets 'boucle 1 : sur tous les onglets
    Select Case WS.Name 'agit en fonction du nom de l'onglet
        Case "Feuil2", "Recapmois", "Matrice" 'cas "Feuil2", "Recapmois" et "Matrice" (rien ne se passe)
        Case Else 'autres cas
            DL = WS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définir la dernière ligne éditée DL de l'onglet de la boucle
            For I = 13 To DL 'boucle 2 : sur toutes les lignes I de l'onglet de la boucle (de 13 a DL)
                If WS.Cells(I, "K") <> "" Then 'condition : si la cellule ligne I, colonne K n'est pas vide
                    Set DEST = R.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
                    WS.Cells(I, "B").Resize(1, 14).Copy DEST 'copie la ligne I (la cellule ligne I colonne B redimensionné à 14 colonnes) et la colle dans DEST
                End If 'fin de la condition
            Next I 'prochaine ligne de la boucle 2
    End Select 'fin de l'action en fontion du nom de l'onglet
Next WS 'prochain onglet de la boucle 1
End Sub

Merci Besoin d'aide, merci thau thème pour votre aide !

Ça marche aux petits oignons ton code Thau theme, c'est merveilleux !

Rechercher des sujets similaires à "copier coller certaines lignes fonction critere"