Copier lignes dans autre feuille à la prmière ligne vide

Bonjour,

Mon problème : transférer des lignes d’une feuille dans une autre feuille à la première ligne vide

Mon dossier est constitué de deux feuilles de même structure (mêmes colonnes). Les cellules de colonne A toujours remplies.

Je décris mon problème à l’aide d’un exemple.

Je suis dans mon classeur.

Premier lancement de la macro.

Aller feuille 1

Sélectionner les lignes qui ont « OK » en colonne J. Par ex j’en sélectionne 3.

Transférer ces lignes en feuille 2 à la première ligne vide, par ex ligne 5.

Donc les 3 lignes seront transférées en feuille 2, lignes 5,6 et 7

Revenir feuille 1

Trier feuille 1 suivant les colonnes A et B

Deuxième lancement de la macro.

Aller feuille 1

Sélectionner les lignes qui ont « OK » en colonne J. Par ex j’en sélectionne 5.

Transférer ces lignes en feuille 2 à la première ligne vide, maintenant c’est la ligne 8

Donc les 5 lignes seront transférées en feuille 2, lignes 8,9,10,11 et 12

Revenir feuille 1

Trier feuille 1 suivant les colonnes A et B

Et ainsi de suite …..

Mon problème :

Repérer la première ligne vide da la feuille 2 pour transférer les lignes, de façon à ne pas avoir de lignes vides dans la feuille 2

Merci de votre aide, avec les macros ou VBA

Cordialement

Bonjour et bienvenue,

On est pas obligé de faire çà en plusieurs opérations !

çà se fait direct

Envoie le fichier (raccourci si besoin)

Amicalement

Claude

Merci de ta réponse.

Mais je ne le fais pas en plusieurs fois.

Dans mon exemple, entre le lancement 1 et le lancement 2 de la macro, il y a eu des modifs dans la feuille 1. Quand je fais le lancement 1 il n'y a que 3 lignes avec "OK". Puis des lignes de la feuiile 1 ont été modifiées avec "OK" en colonne J qui est vide au départ et quand je lance la deuxième fois, il y a 5 nouvelles lignes.

Je t'envoie un fichier en exemple;

Cordialement

re,

Tu as oublier de joindre le fichier !

Claude

Oui excuse moi.

je te joins un fichier qui présente l'évolution des 2 feuilles. Elle est repérait par Sit dans le nom de la feuille.

Sit 1: avant le premier lancement

Sit 2: ce je souhaite après le premier passage

Sit 3: après quelques jours, la feuille1 a évoluée, notamment par "OK" qui est mon critère de sélection des lignes à transférer.

Sit 4; ce que je souhaite après le deuxième passage

et ainsi de suite

suis je clair?

Sinon dis moi et éventuellement je peux t'appeler.

Merci de ton aide

Cordialement

Bonsoir,

Je ne comprend toujours pas l'objectif ! pourquoi toutes ces feuilles ?

Si dans la 1ère feuille tu mets 3 "Ok", on les extrait sur la Feuil2,

si tu reviens en Feuil1 et que tu ajoute ou supprime des "Ok"

en relançant la macro, la Feuil2 se met à jour.

c'est pas çà que tu veux ?

ou alors explique le but du jeu !

Claude

Bonjour,

Voilà qui devrait faire votre affaire:

J'édite pour préciser que je n'ai pas cherché midi à 14h, toutes les lignes "OK" ont été déplacées Feuil3, puis supprimées de la feuille de départ et enfin cette dernière triée par les colonnes A et B.

Sub transfert()
    Dim derCellColE As Long  'derniere cellule feuille de départ col E
    Dim derCellColA As Long
    Dim i As Long
    derCellColE = Sheets("Sit 1 Feuil1").Range("e65535").End(xlUp).Row + 1
    For i = derCellColE To 2 Step -1
        With Sheets("Sit 1 Feuil1")
            If .Cells(i, 5).Text = "OK" Then
                .Cells(i, 5).EntireRow.Copy _
                    Destination:=Sheets("Feuil3").Range("a65535").End(xlUp).Offset(1, 0)
                .Cells(i, 5).EntireRow.Delete

            End If
        End With
    Next i
    derCellColA = Sheets("Sit 1 Feuil1").Range("a65535").End(xlUp).Row
    Sheets("Sit 1 Feuil1").Range("a1:e" & derCellColA).Sort _
        Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range( _
        "B2"), Order2:=xlAscending, Header:=xlGuess, MatchCase _
        :=False, Orientation:=xlTopToBottom
End Sub

Bonjour?

En effet toutes les lignes OK de la feuille 1 sont copiées dans feuille 2 et supprimées de feuille1.

Mon problème est de positionner ces lignes à la première ligne vide à la suite des autres lignes de la feuille 2

Est ce ce que tu as compris et réalisé dans ton code?

Je vais essayer ton code.

Merci de ton aide

Cordialement

-- 30 Sep 2010, 20:30 --

Bonjour Dubois,

Oui le transfert des lignes est facile. Mon problème est de positionner, à chaque lancement de la macro, les nouvelles lignes extraites de la feuille 1 en dessous des autres lignes, sans ligne vide, dans la feuille 2.

Entre 2 lancemnets de macro, la feuille1 est modifiée et il peut y avoir plusieur jours.

Dans mon dossier il n ' y a que 2 feuiiles.

Dans mon ex, il y a 4 fois les deux feuilles pour expliquer ce que je cherche.

Merci de ton aide

Cordialement

Bonsoir,

Je voyais simplement un filtre, mais j'ai dû louper un épisode !

Vois quand même

Sub Filtre()
Dim Lg%
    Lg = Range("A65536").End(xlUp).Row
    Range("a1:e" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("o1:o2"), CopyToRange:=Sheets("Feuil2").Range("a1:d1"), Unique:=False
End Sub

Amicalement

Claude

Bonsoir Claude,

Merci pour ta réponse.

J'ai lancé la macro que tu as faite.

J'ai bien retrouvé les 3 lignes en feuille 2 mais les lignes qui étaient déjà en feuille 2 ont disparu.

Ce que je cherche c'est que les 3 lignes viennent se mettre juste au dessous des lignes déjà existantes dans la feuille 2.

Excuse moi d'insister. Mais c'est parce que je ne suis pas clair.

Merci de ton aide

Cordialement

tu t'adresse à qui là ?

Claude

Je te place la macro dans un classeur pour que ce soit plus facile à utiliser.

SI il y a dans la feuille "Sit 1 Feuil1" des "OK" en colonne E (sit), alors après lancement de la macro via le bouton

sur la feuille, elles sont déplacées Feuil3 là ou il y a des lignes vides.

SI ce n'est pas cela que tu veux, je ne comprends pas.

Bonjour à tous,

Dernière tentative (pour ma part)

Sub Déplace()
Dim Lg%, Plg As Range
'Macro par Claude Dubois pour "PasDan" Excel-Pratique le 01/10/10
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo Fin
    Range("o2") = "=e2=""ok"""
    Lg = Range("A65536").End(xlUp).Row
    Range("a1:e" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("o1:o2"), Unique:=False

    Set Plg = Range("a2:d" & Lg).SpecialCells(xlCellTypeVisible)
    Plg.Copy Destination:=Sheets("Feuil2").Range("A65536").End(xlUp)(2)
    Plg.EntireRow.Delete
Fin:
    On Error Resume Next
    ActiveSheet.ShowAllData
End Sub

Amicalement

Claude