Eliminer des lignes non remplies

[jin150866]

Bonjour voila mon petit probleme :
dans mon fichier comptabilite, j'ai fais une feuille 'Journal de comptabilite' ou je met tous mes deplacements d'argents pour le compte de l'association, apres tout va dans les onglets specifiques selon la nature des mouvements financiers.
Dans le fichier ci-joint, dans l'onglet 'avant' voila comment se presente le tableau.
J'ai fais une macro de tri mais elle ne m'enleve pas les lignes 'orphelines' entres les mouvements d'argent.
Comment modifier cette macro pour qu'elle le fasse automatiquement pour que j'obtienne un tableau comme dans l'onglet 'apres'.

Merci d'avance pour les reponses

Jin

 

[Dranreb]

Re : Eliminer des lignes non remplies

Bonjour
Comme ça par exemple:

Feuil1.[A4:A33].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Cordialement.

 

[Staple1600]

Re : Eliminer des lignes non remplies

Bonsoir à tous

ÉDITION: Bonsoir Dranreb

Essayes simplement avec le filtre automatique

Sub Macro1()
 ' Macro1 Macro 
' Macro enregistrée le 01/07/2012 par Staple 
Range("A3:E35").AutoFilter Field:=2, Criteria1:="" 
End Sub

PS: Au préalable défusionner la cellule TOTAL et choisir à la place Centre sur plusieurs colonnes.
L'affichage restera identifque quand la cellule était fusionnée, mais ce changement permet le fonctiionnement le macro

 

[Yaloo]

Re : Eliminer des lignes non remplies

Bonjour jin150866, le fil,

Vois avec ça :

Sub SuppLigneVides()
Dim DerLi As Long, r As Long
  With ActiveSheet.UsedRange
    DerLi = .Row + .Rows.Count - 1
  End With
  For r = DerLi To 4 Step -1
    If Cells(r, 2) = "" Then Rows(r).Delete
  Next r
  DerLi = Cells(Rows.Count, 1).End(xlUp).Row
  Rows(DerLi + 1).EntireRow.Insert
End Sub

A te relire

Martial

 

[jin150866]

Re : Eliminer des lignes non remplies

Merci Staple1600 et Drareb pour vos reponses si rapides mais cela ne fonctionne pas car je perd les valeurs de mon tableau !

 

[Staple1600]

Re : Eliminer des lignes non remplies

Re


Et comme cela ?
Sans rien toucher à ton tableau initial
Copies ces deux codes et essaies la macro FIltrer , en étant sur la feuille Avant

NB: J'ai testé sur mon PC (et c'est OK) avant de poster mon message

Sub Filtrer()
If Not ActiveSheet.FilterMode Then ActiveSheet.FilterMode = True
Range("C3:D35").AutoFilter Field:=1, Criteria1:="<>"
End Sub

Sub Afficher()
Selection.AutoFilter
End Sub

 

[Dranreb]

Re : Eliminer des lignes non remplies

cela ne fonctionne pas car je perd les valeurs de mon tableau !

Ça m'est arrivé aussi au 1er test parce que j'avais dit de prendre les ligne entières de 4:33 qui contiennent toutes au moins une cellule vide dans une colonne quelconque ! Bien s’appuyer sur une seule colonne dont on veut supprimer les cellules vides définies par SpecialCells(xlCellTypeBlanks), le .EntireRow.Delete ne vient qu'à la fin.

 

[jin150866]

Re : Eliminer des lignes non remplies

Moi voila ce que j'ai ecrit :

sub TRI_AVEC_PROTECTION()
'
' TRI_AVEC_PROTECTION Macro
' Macro enregistrée le 19/06/2012 par METZGER Jeannot
'

'
Range("A4:E1000").Select
ActiveSheet.Unprotect
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Ca me m'enleve rassemble les lignes sans enlever celles qui sont vides entre les lignes ou il y a des actifs financiers !

 

[Dranreb]

Re : Eliminer des lignes non remplies

ben oui, forcément puisque vous n'avez pas mis d'instruction qui les enlève !

 

[Staple1600]

Re : Eliminer des lignes non remplies

Re,

jin150866
As-tu essayé ma proposition plus bas avec le filtre automatique ?

Moi voila ce que j'ai ecrit :

sub TRI_AVEC_PROTECTION()
'
' TRI_AVEC_PROTECTION Macro
' Macro enregistrée le 19/06/2012 par METZGER Jeannot
'

'
Range("A4:E1000").Select
ActiveSheet.Unprotect
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Ca me m'enleve rassemble les lignes sans enlever celles qui sont vides entre les lignes ou il y a des actifs financiers !

 

[jin150866]

Re : Eliminer des lignes non remplies

Desole Staple1600 mais cela ne fonctionne pas !

 

[job75]

Re : Eliminer des lignes non remplies

Bonsoir à tous,

Avec le filtre élaboré (avancé) :

Sub Filtre()
Dim plage As Range
Set plage = Intersect([A2:E65536], ActiveSheet.UsedRange)
[F3].Formula = "=COUNT(A3:E3)"
plage.AdvancedFilter xlFilterInPlace, [F2:F3]
[F3] = ""
End Sub

Sub AfficheTout()
On Error Resume Next
ActiveSheet.ShowAllData
End Sub

Fichier joint.

Bonne nuit et A+

 

[job75]

Re : Eliminer des lignes non remplies

Re,

Pour le critère on peut utiliser cette formule, plus générale :

[F3].Formula = "=COUNT(A3:E3)+COUNTIF(A3:E3,""?*"")"

Fichier (2).

A+

 

[Staple1600]

Re : Eliminer des lignes non remplies

Bonsoir, job75

Desole Staple1600 mais cela ne fonctionne pas !

Si cela fonctionne, sinon pourquoi j'aurai posté le code VBA...

Maintenant que sur ton PC, tu n'arrives pas à le faire fonctionner , la c'est possible.

PS: Mon code fonctionne avec le fichier exemple qui est dans ton message #1
Si tu utilises un autre fichier, il faut évidemment faire des adaptation, notamment vis vis des adresses des cellules à filtrer

@->Job75
Pour le plaisir de te croiser et pour faire plaisir à mes endives et avec une autre formule (Qu'en penses-tu ?)

Sub Filtre()
Dim plage As Range
Set plage = Intersect([A2:E65536], ActiveSheet.UsedRange)
With [F3]
    .Formula = "=COUNT(RC[-5]:RC[-1])>1"
    plage.AdvancedFilter xlFilterInPlace, [F2:F3]
    .Value = Empty
End With
End Sub

 

[job75]

Re : Eliminer des lignes non remplies

Bonjour à tous,

Autre solution, sans filtre, qui recherche les valeurs numériques :

Sub Masque()
Dim plage As Range
Application.ScreenUpdating = False
On Error Resume Next
Set plage = Intersect([A3:E65536], ActiveSheet.UsedRange)
plage.EntireRow.Hidden = True
plage.SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = False
plage.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Hidden = False
End Sub

Sub AfficheTout()
Rows.Hidden = False
End Sub

Fichier joint.

A+