Discussion :

[jpvba]

Bonjour a vous chers amis,



J'ai un petit problème. Certains usagers importent des données d'un logiciel afin de pouvoir les traiter dans un classeur excel. Cependant ils copient également des cellules vides ayant une mise en page ou je ne sais pas trop quoi faisant alourdir le fichier. Par exemple le fichier est de 36mo et une fois que je passe onglet par onglet et je détruire ls lignes vides susceptibles d'avoir du code le fichier redeviens a une grosseur de 376Ko. Ce qui est nettement plus rapide a ouvrir et facile a transférer via courriel.


J'ai fais quelques tentatives afin d'automatisé le passage de feuilles en feuilles et supprimer les lignes vides mais j'arrives a un code lent et ne supprimant pas les lignes ayant une données dans la colonne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub efface_blanc()
Dim ws As Worksheet
 
Application.ScreenUpdating = False
 
For Each ws In ActiveWorkbook.Sheets
 
Range("a:XFD").SpecialCells(xlCellTypeBlanks).Rows.Delete
 
Next ws
 
Application.ScreenUpdating = True
 
End Sub

Est-ce que vous auriez une solution a mon problème i.e. un code permettant de supprimer tous les lignes vides ou un code permettant de tous supprimer sauf les zones ayant du contenu ???


Bref un code permettant d'automatisé le fait de détruire les cellules vides d'un classeur entier afin de le faire maigrir.


en vous remerciant pour votre aide !!!

[Invité]

Bonjour,

Perso, j'utilise le tri. Une solution possible avec ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 
Option Explicit
 
Sub LancerLaMiseEnForme()
 
Dim ShATrier As Worksheet
Dim DerniereLigne As Long, LigneDeTitre As Long, ColonneATrier As Long, DerniereColonne As Long, I As Long
 
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
 
    Set ShATrier = ActiveSheet
 
    With ShATrier
 
         LigneDeTitre = 1
         ColonneATrier = 1  ' Colonne où vous êtes sûr de ne pas avoir de cellules vides.
         DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
 
         ' Suppression des colonnes
         .Range(.Cells(LigneDeTitre, DerniereColonne + 1), .Cells(LigneDeTitre, .Columns.Count)).EntireColumn.Clear
         For I = DerniereColonne To 1 Step -1
             If WorksheetFunction.CountA(.Columns(I)) = 0 Then .Columns(I).Delete Shift:=xlToLeft
         Next I
 
         TrierUnTableau ShATrier, LigneDeTitre, ColonneATrier
 
         ' Suppression des lignes
         DerniereLigne = .Cells(.Rows.Count, ColonneATrier).End(xlUp).Row
         .Range(.Cells(DerniereLigne + 1, 1), .Cells(.Rows.Count, DerniereColonne)).Clear
 
    End With
 
    Set ShATrier = Nothing
 
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
 
  MsgBox "Fin de traitement !", vbInformation
 
End Sub
 
 
Sub TrierUnTableau(ByVal ShATrier2 As Worksheet, ByVal LigneDeTitre2 As Long, ByVal ColonneATrier2 As Long)
 
Dim DerniereColonne2 As Long
Dim DerniereLigne2 As Long
 
Dim AireATrier As Range
Dim AireColonne As Range
 
    With ShATrier2
 
         DerniereColonne2 = .Cells(LigneDeTitre2, .Columns.Count).End(xlToLeft).Column
         DerniereLigne2 = .Cells(.Rows.Count, ColonneATrier2).End(xlUp).Row
 
         If DerniereLigne2 > LigneDeTitre2 Then
            Set AireATrier = .Range(.Cells(LigneDeTitre2, 1), .Cells(DerniereLigne2, DerniereColonne2))
            Set AireColonne = .Range(.Cells(LigneDeTitre2, ColonneATrier2), .Cells(DerniereLigne2, ColonneATrier2))
 
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=AireColonne, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                 .SetRange AireATrier
                 .Header = xlYes
                 .MatchCase = False
                 .Orientation = xlTopToBottom
                 .SortMethod = xlPinYin
                 .Apply
             End With
 
             Set AireColonne = Nothing
             Set AireATrier = Nothing
 
          End If
 
    End With
 
End Sub

[jpvba]

Genial mon cher ami !!!


Je la loop pour l'ensemble des feuilles et l'affaire est ketchup !!



mille fois merci !!!