couper lignes entière si cellules de colonnes non vides

eldorado

XLDnaute Nouveau
Bonjour à tous,
Je veux résoudre un problème que je tarde depuis quelque temps.
J’ai deux tableaux dans deux feuilles différentes qui ont les mêmes entêtes, je veux faire une condition qui me permets lorsqu’une cellule d’une colonne bien définis (colonne spécifique) est non vide, la ligne entière est couper sinon copier dans le tableau de l’autre feuille.
Ensuite je compte au cas où j’ai plusieurs feuilles reproduire le même événement dans le même tableau dans une autre feuille.
Je vous remercie d’avance.
 

Pièces jointes

  • couper ligne entière si cellules non vides.xls
    30.5 KB · Affichages: 69

Robert

XLDnaute Barbatruc
Repose en paix
Re : couper lignes entière si cellules de colonnes non vides

Bonjour Eldorado, bonjour le forum,

Essaie comme ça (pas eu le temps de commenter le code...) :
Code:
Sub Macro1()
Dim dl As Integer
Dim pl As Range
Dim cel As Range
Dim dest As Range

Application.ScreenUpdating = True
With Sheets("uyio")
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
    Set pl = .Range("A3:D" & dl) 'définit la plage pl
    .Range("A2").AutoFilter
    .Range("A2").AutoFilter field:=4, Criteria1:="<>"
    For x = 2 To Sheets.Count
        With Sheets(x)
            Set dest = .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
            pl.SpecialCells(xlCellTypeVisible).Copy dest
        End With
    Next x
    .Range("A2").AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : couper lignes entière si cellules de colonnes non vides

Bonsoir Eldorado, bonsoir le forum,

Le code modifié pour (et enfin commenté) le CUT... :
Code:
Sub Macro1()
Dim dl As Integer 'décalre la variable dl (Dernièr Ligne)
Dim pl As Range 'décalre la variable pl (PLage)
Dim dest As Range 'décalre la variable dest (cellule de DESTination)

Application.ScreenUpdating = False 'masque les changements à l'écran
With Sheets("uyio") 'prend en compte l'onglet "uyio"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
    Set pl = .Range("A3:D" & dl) 'définit la plage pl
    .Range("A2").AutoFilter 'active le filtre automatique en A2
    .Range("A2").AutoFilter field:=4, Criteria1:="<>" 'filtre automatique sur D2, critère : non vide
    For x = 2 To Sheets.Count 'boucle sur tous les onglets du classeur (en partant du second)
        With Sheets(x) 'prend en compte l'onghlet de la boucle
            Set dest = .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            pl.SpecialCells(xlCellTypeVisible).Copy dest 'copie et colle les cellules visibles de la plage pl dans dest
        End With 'fin de la prise en compte de l'onghlet de la boucle
    Next x 'prochain onglet de la boucle
    pl.SpecialCells(xlCellTypeVisible).EntireRow.Delete shift:=xlShiftUp 'suprime les cellules visible de la plage pl
    .Range("A2").AutoFilter 'supprime le filtre automatique
End With 'fin de la prise en compte de l'onglet "uyio"
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 429
Messages
2 088 350
Membres
103 823
dernier inscrit
ben talha redouane