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

rh.finances

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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 :
VB:
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+
 

Pièces jointes

  • SUIVI COMPTE v.5.xlsm
    335.2 KB · Affichages: 4
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
313 205
Messages
2 096 209
Membres
106 530
dernier inscrit
miomi98