Lignes effacées à la copie VBA

Bonjour à tous et merci d'avance pour votre aide,

Grace au forum j'ai pu créer une macro qui me permet de couper une ligne d'une feuille en fonction d'un critère et la coller sur une autre feuille. Le problème est que cela efface les lignes qui existaient déjà sur la feuille de copie et duplique la nouvelle ligne.

Voici le code

Sub Macro1()

'

' Macro1 Macro

'

' Touche de raccourci du clavier: Ctrl+g

'

Application.Goto Reference:="Macro1"

Sub Filtre()

Range("o2") = "=AND(i2=""ok"")"

Range("a1:m" & Range("b65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _

Range("o1:o2"), CopyToRange:=Sheets("archive").Range("a1:m1"), Unique:=False

Range("o2").ClearContents

Dim dlg As Integer, lg As Integer, i As Integer

With ActiveSheet

dlg = .Range("A" & Rows.Count).End(xlUp).Row

For i = dlg To 2 Step -1

If UCase(Range("I" & i)) = "OK" Then

lg = Sheets("ARCHIVE").Range("A" & Rows.Count).End(xlUp).Row + 1

.Range("A" & i & ":I" & i).Copy Sheets("ARCHIVE").Range("A" & lg)

.Rows(i).Delete

End If

Next

End With

End Sub

Merci pour votre concours

Bonjour le forum, bonjourDomSage

Perso je préfère avoir un fichier pour tester

Merci

Bonjour DomSage,

Je te propose ce code VBA :

Option Explicit

Sub Filtre()
  Dim dlg&, lg&, i&
  ' Dim dlg& : notation abrégée de : Dim dlg As Long
  ' note bien que dlg, lg et i sont des Long, pas des Integer
  ' car si ligne > 32767 : plantage avec Integer !
  Application.ScreenUpdating = False
  With Worksheets("ARCHIVE")
    ' [O2] = "=AND(I2=""OK"")"
    ' AND inutile car y'a une seule condition !!!
    [O2] = [I2] = "OK"
    ' en O2 : VRAI si I2 = "OK" ; sinon : FAUX
    dlg = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1:M" & dlg).AdvancedFilter 2, [O1:O2], .[A1]
    [O2].ClearContents
    ' remarque bien que lg est calculé une seule fois,
    ' avant la boucle For, et sera incrémenté ensuite
    lg = .Range("A" & Rows.Count).End(xlUp).Row + 1
    dlg = Range("A" & Rows.Count).End(xlUp).Row
    For i = dlg To 2 Step -1
      If UCase(Range("I" & i)) = "OK" Then
        Cells(i, 1).Resize(, 9).Copy .Cells(lg, 1)
        Rows(i).Delete: lg = lg + 1
      End If
    Next i
  End With
End Sub

Cette macro doit être lancée depuis la feuille active (autre que "ARCHIVE")

et le résultat sera sur la feuille "ARCHIVE" grâce au With .. End With.

Non testé car sans ton classeur, donc à tester et bien vérifier !

Merci de me donner ton avis.

Cordialement,

dhany

Bonjour,

Merci pour votre réponse. Je ne me suis pas penchée sur la question ce week-end je viens d'essayer, mais j'ai toujours le même problème le déplacement dans une autre feuille, supprime les déplacement précédent. Je vous joins mon classeur

Merci pour votre aide

Dominique

Bonjour DomSage,

Je te retourne ton fichier Excel modifié :

À l'ouverture du fichier, tu es sur la feuille "ARCHIVE", et la cellule active est I1002 ; c'est pour que tu vois que sur cette feuille, j'ai ajouté beaucoup de lignes ; les bordures allant jusqu'en ligne 1000, il y a donc de la place pour archiver tes lignes "ok" jusqu'en ligne 1000, soit 999 lignes car à partir de la ligne 2.

Fais Ctrl Début : la cellule active est A2 (et pas A1) car j'ai figé les volets sur cette feuille aussi, comme tu l'avais déjà fait pour la 1ère feuille ; de plus, pour chaque feuille, les colonnes A à I ont exactement la même largeur.

Remarque bien que le tableau est entièrement vide : il n'y a que les en-têtes et les bordures.


Va maintenant sur la 1ère feuille "Feuil1" ; la cellule active est I202 ; là aussi, j'ai ajouté beaucoup de lignes ; les bordures allant jusqu'en ligne 200, il y a donc de la place pour saisir tes lignes jusqu'en ligne 200, soit 199 lignes car à partir de la ligne 2.

Note bien cette proportion : tu as de la place en feuille "ARCHIVE" pour archiver 5 × 200 lignes de données ; si dans ton cas réel ce n'est pas suffisant, pense à ajouter des lignes supplémentaires avant exécution de la macro.

Fais Ctrl Début : la cellule active est A2 et tu peux voir toutes les données actuelles, dont 2 lignes avec "ok".


Ctrl e ➯ travail effectué : tes lignes "ok" disparaissent du tableau, après avoir été copiées en feuille "ARCHIVE" ; je te laisse le vérifier, et sache que tes prochaines lignes "ok" seront copiées en dessous ; mais rappelle-toi d'ajouter des lignes si tu penses que la place va manquer.

Si tu fais Ctrl e sur la feuille "ARCHIVE", ça ne fait rien mais c'est normal ; la macro ne doit être exécutée que depuis "Feuil1".


Alt F11 pour voir la macro, puis revenir sur Excel

Si besoin, tu peux me demander une adaptation.

Merci de me donner ton avis.

Cordialement,

dhany

merci pour ta réponse je test cela en fin d'aprém et je te dis.

En tout cas tes explications sont très précises

Merci beaucoup,

C'est exactement ce dont j'avais besoin

Bonne fin journée

Rechercher des sujets similaires à "lignes effacees copie vba"