Suppression de ligne après couper/coller automatique

[Elenwe95]

Bonjour tout le monde !

Me revoilà pour une autre question !

Alors, voilà, je souhaite couper coller automatiquement les lignes où il y aurait TERMINE dans la colonne C, j'ai donc adapté ce code à mes besoins :

Sub CouperColler()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
 
  Sheets("Feuil2").Activate 'feuille de destination
 
  Col = "C"                 'colonne de la donnée non vide à tester
  NumLig = 1                'Ligne où doivent se copier les données dans Feuil2 (L1=0)
  With Sheets("Feuil1")     'feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 2 To NbrLig     'Numéro de ligne où commencer le "tri"
    If .Cells(Lig, Col).Value = "TERMINE" Then
      .Cells(Lig, Col).EntireRow.Cut    'Cut pour couper, Paste pour copier
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveSheet.Paste
    End If
  Next
  End With
   
End Sub

Ce code fonctionne parfaitement, cependant, puisqu'il me coupe les lignes de ma feuil1, celles-ci restent blanches et je n'arrive pas à trouver comment supprimer ces lignes blanches !

Est-ce donc possible ?

Je vous remercie

 

[pierrejean]

Bonjour Elenw95

A tester:

For Lig = NbrLig to 2 step-1 'Numéro de ligne où commencer le "tri"
If .Cells(Lig, Col).Value = "TERMINE" Then
.Cells(Lig, Col).EntireRow.Cut 'Cut pour couper, Paste pour copier
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
Rows(Lig).delete
End If
Next

 

[Elenwe95]

Bonjour et merci beaucoup pour votre réponse

Alors, du coup ça ne fonctionne plus et ça ne supprime pas non plus les lignes.

En fait, il n'y a que la première ligne qui se colle (en laissant toujours une ligne blanche sur la page source). Les autres, elles, s'effacent et ne se copient plus (mais laissent quand même leur ligne blanche)

Et j'ai un autre soucis, qui n'a rien à voir avec les lignes blanches : Comment puis-je, sur la feuille de destination, voir les lignes se copier les unes par dessus les autres, car lorsque je lance la macro, elle me copie, logiquement, tout à la ligne 2, m'effacant donc les anciennes données (je n'y avais pas pensé...)

 

[pierrejean]

Re

Peux-t-on avoir un fichier exemple (copie de l'original sans données confidentielles) ?

 

[Elenwe95]

Voici un fichier exemple

La macro a été exécutée une fois seulement pour exemple

Ce n'est pas une copie de l'original vu qu'à peu près tout est confidentiel
Mais j'adapterais sans soucis le code

 

[pierrejean]

Re

Code modifié
NB: Il conviendra peut-être de trier le résultat en Feuil2

Sub Terminé_Archivage()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Sheets("Feuil2").Activate 'feuille de destination
Col = "C" 'colonne de la donnée non vide à tester
NumLig = 1 'Ligne où doivent se copier les données dans Feuil2 (L1=0)
' With Sheets("Feuil1") 'feuille source
NbrLig = Sheets("Feuil1").Cells(65536, Col).End(xlUp).Row

For Lig = NbrLig To 2 Step -1 'Numéro de ligne où commencer le "tri"
If Sheets("Feuil1").Cells(Lig, Col).Value = "TERMINE" Then
Sheets("Feuil1").Cells(Lig, Col).EntireRow.Cut 'Cut pour couper, Paste pour copier
NumLig = NumLig + 1
Sheets("Feuil2").Cells(NumLig, 1).Select
Sheets("Feuil2").Paste
Sheets("Feuil1").Rows(Lig).Delete
End If
Next
' End With

End Sub

 

[Backhandshot]

Bonjour Elenwe95, pierrejean et le forum
Voici ton fichier modifié, vois si cela te convient

Salutations !

 

[Backhandshot]

Bonjour Elenwe95, pierrejean et le forum

Erreur dans l'explication de la macro:
'On définit les mots clés
MotCle = Array("Termine")
'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1

et devrait être

'On définit les mots clés
MotCle = Array("Termine")
'On effectue la recherche de chaque mot clé dans la colonne C de la sheet1

désolé
Bonne journée!