VBA Suppression cellules inactives. Utilisation d'une fonction

vivi4561

XLDnaute Junior
Bonjour,

En cherchant sur le net j'ai trouvé une fonction permettant de "nettoyer" un fichier excel de toutes ces cellules vides non utilisées. Voici le code (qui est bien connu ...)
:

Code:
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
Dim Avant As Double, plage As Range
Dim MemVisible
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par GeeDee@m6net.fr"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
' Si la feuille est masquée
MemVisible = Sht.Visible
If Sht.Visible <> xlSheetVisible Then Sht.Visible = xlSheetVisible
'
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
'ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") _
& " de la taille initiale", _
vbInformation, ActiveWorkbook.FullName
'
Sht.Visible = MemVisible
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) _
  & FileLen(ActiveWorkbook.FullName), vbInformation, _
  ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Tout ça marche très bien mais je souhaiterai pouvoir mettre ce code dans mon fichier et qu'il ne scrute pas tous les onglets mais juste l'onglet où je fais appel à cette fonction.
J'ai tenté de modifié le fichier en enlevant la partie suivante mais cela ne marche pas.
For Each Sht In Worksheets
' Si la feuille est masquée
MemVisible = Sht.Visible
If Sht.Visible <> xlSheetVisible Then Sht.Visible = xlSheetVisible
'
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address

Savez vous comment je pourrais adapter ce code ?

En vous remerciant,


Vincent
 
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : VBA Suppression cellules inactives. Utilisation d'une fonction

Bonjour vivi4561, le fil, le forum
Remplace
VB:
For Each Sht In Worksheets
par
VB:
Set Sht = ActiveSheet
et met
VB:
Next Sht
en remarque
VB:
'Next Sht
Cordialement
 

Discussions similaires

Réponses
8
Affichages
620