[XL-2007] Supprimer les lignes non utilisées VBA [Résolu]

[Gaia77]

Bonjour, je suis tout nouveau sur ce forum et je suis novice aussi en VBA !
Cela fait un bout de temps que j'essaye de me débrouiller tout seul, mais là je cale !
Alors voilà le problème,
Je souhaiterais supprimer les lignes vides qui ne contiennent pas de données dans une feuille excel.
Je m'explique sur mon onglet Feuil1, j'ai des données qui vont jusqu'à la ligne 5, or lorsque je fait Ctrl + Fin on constate qu'il y a des lignes sans données (le curseur se positionne en J13 mais que je souhaiterait supprimer.
Merci pour votre aide

Gaia77

[ZebreLoup]

Chez moi, ça va bien en G5. Je suppose que tu as déjà essayé de sauver, fermer et rouvrir ton classeur ?

[Gaia77]

en effet... c'est étrange !
Quoiqu'il en soit dans le fichier réel, j'ai bien ce problème et je ne sais pas comment le résoudre. Une idée ?

[ZebreLoup]

Je pense que ça devrait marcher :

Code :

ActiveSheet.SpecialCells(xlCellTypeBlanks).Delete

[Gaia77]

J'ai une erreur d'exécution 438 - Propriété ou méthode non géré par cet objet !
Pourtant la macro est simple, j'ai mis :

Code :

1
2
3
Sub Efface()
ActiveSheet.SpecialCells(xlCellTypeBlanks).Delete
End Sub

[MarcelG]

Bonjour à vous deux, Bonjour le Forum,

Ici, la ligne entière est supprimée si une cellule est vide.
Il manque la propriété EntireRow à ton objet Range.

Soit (à adapter)

Code :

1
2
3
4
5
6
7
8
Public Sub ESSAI()
Dim fin As Range
With Sheets(1)
        Set fin = Cells(.Rows.Count, 1).End(xlUp)
        .Range("A1", fin).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Set fin = Nothing
End Sub

Bonne journée.

[ZebreLoup]

Je ne pense pas qu'il voulait que la ligne entière soit supprimée. Il veut juste ne plus avoir de "cellules fantômes". Je vais regarder pourquoi ça bug. Je ne me souviens plus si j'ai testé ou pas.

Désolé, c'était :

Code :

1
2
3
Sub Efface()
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks).Delete
End Sub

Le SpecialCells s'applique à un Range et pas à une feuille. Oups.

[Gaia77]

Merci MarcelG pour ta rapidité, mais je n'arrive pas à adapter ton code à mon fichier (je suis archi-débutant....)
Pourrais-tu m'expliquer ce que je dois faire, cela m'aiderai à mieux comprendre

[ZebreLoup]

Erratum, fais plutôt

Code :

1
2
3
Sub Efface()
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks).Clear
End Sub

Sinon, s'il y a des lignes vides, elles vont disparaître.

On est bien d'accord que tu ne veux faire disparaître aucune ligne ou colonne et que c'est simplement enlever les "cellules fantômes".

[Gaia77]

Oui c'est bien ce que je veux Zebreloup, mais ta macro ne fonctionne pas (en tout cas sur mon fichier)
Es-ce parceque j'ai 25000 lignes "fantômes" ????

[MarcelG]

Salut,

Dans le 1er post, il s'agissait de supprimer la ligne.
Quoiqu'il en soit, il est possible de remplacer les "celllules fantômes", si elles sont constantes, par des cellules vides et, si on le souhaite, supprimer la ligne ensuite.

Soit

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Public Sub ESSAI()
Dim fin As Range
With Sheets(1)
        Set fin = Cells(.Rows.Count, 1).End(xlUp)
        With .Range("A1", fin)
                .Replace What:="fantôme", Replacement:="", LookAt:=xlPart
                 'si souhaité                
                .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With
End With
Set fin = Nothing
End Sub

[ZebreLoup]

@MarcelG : Ce que j'appelle "Cellules fantômes" sont les cellules qui paraissent vides, mais si on un Ctrl+Flèche ou Ctrl+Fin le déplacement s'arrête sur ces cellules. C'est un peu le même phénomène qui fait que l'ascenseur de droit peut rester tout petit alors qu'on n'a plus que quelques lignes. Dans ce cas on effaces toutes les lignes vides et on sauve, l'ascenseur reprend une taille normale.

@Gaia77 : Quand tu dis que ça ne marche pas, ça bug ou ça ne fait rien ?

[Gaia77]

Merci Zebreloup, tu as très clairement exprimé le problème !
Quand je dis que ça ne marche pas, c'est que la macro ne fait rien... En faisant Ctrl+Fin, la cellule active se retrouve toujours en ligne 25000 alors que je n'ai que 269 lignes....
Par contre la macro ne se plante pas....

[ZebreLoup]

Essaie avec ce code et dis-moi si ça marche (En espérant qu'il ne soit pas trop lent)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Sub efface()
    Application.ScreenUpdating = False
 
    Dim ws As Worksheet
    Set ws = Worksheets("Feuil2") 'Mettre ici le nom de la feuille ou remplacer par ActiveSheet
 
    Dim rg As Range
    Set rg = ws.Range(ws.Range("A1"), ws.Range("A1").SpecialCells(xlCellTypeLastCell))
 
    Dim subRg As Range
 
    For Each subRg In rg.Cells
        If subRg.Value = "" And subRg.Formula = "" Then
            subRg.Clear
        End If
    Next subRg
 
    Application.ScreenUpdating = True
End Sub

[Ormonth]

Bonjour,

Tu as un problème sur un classeur et 269 lignes..

Pour ne pas perdre de temps, tu crée un classeur vierge, tu y copies tes 269 lignes et le reste si d'autres feuilles, tu le sauves "MonClasseur-V2"

tu testes, si OK, tu écrases l'ancien, tu renomme le nouveau / ancien et tu continues à bosser.

Sur l'ancien tu peux tester ce code suivant dans la fenêtre d'exécution :

Code :

? ActiveSheet.UsedRange.CountLarge

juste pour voir le nombre retourné...

note : UsedRange a la fâcheuse habitude de prendre en compte les cellules fantômes justement...

Cordialement,

Ps : si le côté technique de la réponse = OK ou pas => pensez à cliquer sur les pouces et quand question résolue à la taguer résolue, et chaque action vous rapporte des points

Didier

[MarcelG]

Bonjour Didier,

L'une des références Excel VBA, Laurent Longre, a codé

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub NettoieEtDerniereCellule()     ' Laurent Longre
  Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
  On Error Resume Next
  Calc = Application.Calculation
  With Application
    .Calculation = xlCalculationManual
    .StatusBar = "Nettoyage en cours..."
    .EnableCancelKey = xlErrorHandler
    .ScreenUpdating = False
  End With
  For Each Sht In Worksheets
    If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
      Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
      If Not DCell Is Nothing Then
        Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
        Set DCell = Nothing
        Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
        If Not DCell Is Nothing Then _
 Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
      End If
      Rien = Sht.UsedRange.Address
    End If
  Next Sht
  Application.StatusBar = False
  Application.Calculation = Calc
End Sub

Autant dire que je n'aurais pas trouvé!

[Gaia77]

Merci à tous pour votre aide précieuse, en final c'est le code proposé par MarcelG (Laurent Longre) qui correspond à ce que je voulais !

ça m'a vraiement ôté une épine d'une pied !
Je pense que vous allez me revoir dans pas longtemps, car j'ai encore plein de choses à apprendre !
Merci


Gaia77