XL 2019 supprimer lignes vides qui ont été coupées - collées

[rh.finances]

Bonjour à tous les internautes de ce site,

Etant peu aguerri en VBA, je bute sur un point qui je l’espère pourra être résolu par des internautes expert.

J’ai mis en pièce-jointe un fichier comprenant un tableau de saisie de données dans l’onglet « détail dép - rec en cours ».

Grace à une macro enregistrée en « module 2 » et lorsqu’il est sélectionné « oui » en colonne H du tableau de saisie des données, les lignes concernées sont coupées – collées dans les onglets de couleur bleue.

La macro en question fonctionne très bien. Toutefois, lorsque l’on active celle-ci, les lignes qui ont été coupées – collées restent vides et je souhaiterais en fait que celles-ci disparaissent du tableau.
Attention, l’objectif est de supprimer uniquement les lignes qui ont été coupées-collées. Je souhaite en effet conserver les lignes complétées ainsi que les autres lignes vides (à partir de la ligne 14 notamment) afin de les exploiter ultérieurement.

J’espère que mes explications ont été claires et merci d’avance de vos contributions.

Bonne soirée

Bien cordialement

Alex

 

[job75]

Bonsoir,

J’ai mis en pièce-jointe un fichier

Il a disparu.

A+

 

[rh.finances]

Bonjour job75, bonjour à tous,
En effet, petit problème de pièce-jointe. voici la fichier en question et merci d'avance pour vos contributions

Bien cordialement

Alex

 

[job75]

Bonjour rh.finances, le forum,

Bah remplacez .Rows(i).ClearContents par .Rows(i).Delete

A+

 

[rh.finances]

Tout simplement oserais-je dire ! mais je n'aurais pas trop trouvé sans l'aide d'un contributeur de ce forum.
Merci mille fois Job75. la solution est parfaite.
Bonne journée
A+

 

[job75]

Bonsoir rh.finances, le forum,

J'ai testé le fichier du post #3 en recopiant le tableau A2:K13 sur 12 000 lignes.

Votre macro (complétée comme je l'ai indiqué) s'exécute en 186 secondes chez moi.

C'est rédhibitoire, il faut utiliser une autre méthode, en voici une :

Sub Copie()
Dim t, ncol%, P As Range, nlig&, i&, deb&, derlig&
t = Timer
Application.ScreenUpdating = False
On Error Resume Next 'si une feuille n'existe pas ou s'il n'y a aucune SpecialCell
With [Tableau1].ListObject.Range 'tableau structuré
    .Parent.Unprotect ""
    ncol = .Columns.Count
    '---création des tableaux---
    Workbooks.Add 'document vierge auxiliaire
    Set P = [A1].Resize(.Rows.Count, ncol)
    P = .Value 'copie les valeurs
    P.Sort P(1, 8), xlAscending, P(1, 11), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
    nlig = Application.CountIf(P.Columns(8), "?*")
    Set P = P.Resize(nlig)
    P.Rows(nlig + 1) = ""
    For i = 2 To nlig
        If P(i, 11) <> P(i - 1, 11) Then deb = i
        If P(i, 11) <> P(i + 1, 11) Then
            With ThisWorkbook.Sheets(P(i, 11).Value)
                derlig = .Cells(.Rows.Count, 11).End(xlUp).Row
                .Cells(derlig + 1, 1).Resize(i - deb + 1, ncol - 1) = P.Rows(deb).Resize(i - deb + 1).Value
            End With
        End If
    Next
    ActiveWorkbook.Close False 'ferme le document auxiliaire
    '---suppression des lignes---
    .Columns(8).Replace "oui", "#N/A", MatchCase:=False
    .Sort .Columns(8), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    Intersect(.Columns(8).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp
    .Parent.Protect ""
End With
MsgBox "Transfert effectué en " & Format(Timer - t, "0.00 \sec"), vbInformation, "Transfert"
End Sub

Sur 12 000 lignes cette macro s'exécute en 1,8 seconde, c'est 100 fois plus rapide.

A+

 

[rh.finances]

Bonjour job75, bonjour à tous,
Désolé du retard de ma réponse et encore une fois, merci pour le travail effectué Job75.
c'est pour le moins bluffant et sacrément efficace !! Bravo
Bonne journée
Alex