XL 2019 Macro couper lignes selon conditions

[satriani]

Bonjour à tous,

Pouvez vous svp m'aider avec une macro pour le besoin suivant :

Si dans la feuille N, les premières lignes avec la colonne A en dessous de l'entête donc à partir de A2 sont vides = couper toutes ces lignes et les coller à la fin de la feuille N-1 et supprimer ces lignes qui deviennent vide de la feuille N.

Ci-joint un petit fichier explicatif.

Merci.

 

[soan]

Bonsoir satriani,

bienvenue sur le site XLD ! 🙂

ton fichier en retour (converti en .xlsm pour pouvoir contenir du code VBA).

* sur "Feuil2", c'est inchangé : tu as bien tes 2 lignes jaunes 2 et 3.

* va sur "Feuil1" ; c'est inchangé aussi ; fais Ctrl e ➯ travail effectué ! 😊
les données des 2 lignes jaunes ont bien été copiées sous le tableau,
et sur "Feuil2", les 2 lignes jaunes ont été supprimées.​

* remarque : ça aurait fait exactement pareil si tu avais lancé la macro
depuis "Feuil2" au lieu de "Feuil1" ; et si y'a plusieurs autres feuilles
dans ton classeur, ça fera pareil aussi, quelle que soit la feuille où
tu fais Ctrl e.

---

code VBA (30 lignes) :

Option Explicit

Sub CpyLigs()
  Dim n%: n = Worksheets.Count: If n = 1 Then Exit Sub 'comme c'est entre
  'la dernière feuille et l'avant-dernière feuille, il n'y a rien à faire
  'si le classeur ne contient qu'une seule feuille : en effet, il faut
  'au moins 2 feuilles !
 
  Worksheets(n).Select 'on va sur la dernière feuille du classeur
 
  Dim dlg&: dlg = Cells(Rows.Count, 1).End(3).Row: If dlg = 1 Then Exit Sub
  'y'a rien à faire non plus si en colonne A, y'a aucune ligne avec une
  'cellule non vide ; en effet, si toutes les données de la colonne A
  'sont vides, la dernière cellule rencontrée en partant du bas est A1,
  'qui contient le texte "Entete 1".
 
  Dim lig&: lig = [A1].End(4).Row: If lig = 2 Then Exit Sub 'sortie de sub,
  'car quand la 1ère ligne non vide est la ligne 2 : y'a aucune ligne vide
  'entre la ligne d'en-têtes et la 1ère ligne non vide !
 
  Application.ScreenUpdating = 0 'la mise à jour de l'écran est désactivée
  Dim plg As Range: Set plg = [A2].Resize(lig - 2, 14)
  Worksheets(n - 1).Select 'on va sur l'avant-dernière feuille du classeur
  plg.Copy 'copie des données adéquates dans le presse-papiers de Windows
  lig = Cells(Rows.Count, 1).End(3).Row + 1 '1ère ligne vide en dessous
  Cells(lig, 1).PasteSpecial -4163 'coller valeurs des données copiées
  plg.EntireRow.Delete 'supprime les lignes dont on a copié les valeurs
  [A1].Select 'on sélectionne la cellule A1
End Sub

soan

 

[satriani]

Bonjour Soan, merci beaucoup pour ta réponse je vais générer un fichier de données et tester en masse 🙏👏

 

[soan]

ok, alors bons tests ! 😄

 

[satriani]

Bonjour Soan, après les premiers tests c'est ok, un grand merci à toi 👏🙏

 

[soan]

Bonjour satriani,

merci pour ton retour ! 😊

soan