Fichier Obèse

Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien amicordi@lement,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:u9k0%23tqLJHA.5648@TK2MSFTNGP05.phx.gbl...

Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée 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("*", , , , xlByRows, 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

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin ?
Merci de votre aide.
--
Cordialement
Guy

Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" <patrick.bastard@dbmail.com.invalid> a écrit dans le
message de news: %23t8TC2qLJHA.5060@TK2MSFTNGP02.phx.gbl...

Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien amicordi@lement,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:u9k0%23tqLJHA.5648@TK2MSFTNGP05.phx.gbl...

Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée 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("*", , , , xlByRows, 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

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin
?
Merci de votre aide.
--
Cordialement
Guy

Re, Guy72.

Je suis arrêté à la ligne "Next Sht"

"Next Sht" signifie en grand breton : "feuille suivante".

--
Bien amicordi@lement,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:ewZVW%23qLJHA.5232@TK2MSFTNGP02.phx.gbl...

Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" <patrick.bastard@dbmail.com.invalid> a écrit dans le
message de news: %23t8TC2qLJHA.5060@TK2MSFTNGP02.phx.gbl...

Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien amicordi@lement,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:u9k0%23tqLJHA.5648@TK2MSFTNGP05.phx.gbl...

Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée 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("*", , , , xlByRows, 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

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin
?
Merci de votre aide.
--
Cordialement
Guy

Bonjour,
Il semble qu'i manque un End If avant Next Sht
--
Cordialement
jpmonnier-nospam@neuf.fr

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:ewZVW%23qLJHA.5232@TK2MSFTNGP02.phx.gbl...

Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" <patrick.bastard@dbmail.com.invalid> a écrit dans le
message de news: %23t8TC2qLJHA.5060@TK2MSFTNGP02.phx.gbl...

Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien amicordi@lement,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:u9k0%23tqLJHA.5648@TK2MSFTNGP05.phx.gbl...

Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée 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("*", , , , xlByRows, 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

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin
?
Merci de votre aide.
--
Cordialement
Guy

Bonjour JP,
Non ça ne fonctionne pas, ça enlève tout, donc pas fiable.
Merci quand même
--
Cordialement
Guy

"JPMonnier" <jpmonnier-no-spam@neuf.fr> a écrit dans le message de news:
em0nhrrLJHA.456@TK2MSFTNGP06.phx.gbl...

Bonjour,
Il semble qu'i manque un End If avant Next Sht
--
Cordialement
jpmonnier-nospam@neuf.fr

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:ewZVW%23qLJHA.5232@TK2MSFTNGP02.phx.gbl...

Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" <patrick.bastard@dbmail.com.invalid> a écrit dans le
message de news: %23t8TC2qLJHA.5060@TK2MSFTNGP02.phx.gbl...

Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien amicordi@lement,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" <guy72@bonjour.tous> a écrit dans le message de
news:u9k0%23tqLJHA.5648@TK2MSFTNGP05.phx.gbl...

Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée 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("*", , , , xlByRows, 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

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en
magasin ?
Merci de votre aide.
--
Cordialement
Guy

Essaie ceci :


Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range
Dim 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("*", _
, xlFormulas, , 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("*", , xlFormulas, _
, xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell.Offset(, 1), Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub





"Guy72" <guy72@bonjour.tous> a écrit dans le message de news:
u9k0%23tqLJHA.5648@TK2MSFTNGP05.phx.gbl...
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée 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("*", , , , xlByRows, 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

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin ?
Merci de votre aide.
--
Cordialement
Guy

Il y a encore une petite coquille sur la procédure transmise.

Correction apportée : ceci devrait fonctionner.

'-------------------------------------------------
Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range
Dim DxCell As Range
Dim 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("*", _
, xlFormulas, , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)). _
EntireRow.Clear
Set DCell = Nothing
Set DxCell = Sht.Cells.Find("*", , xlFormulas, _
, xlByColumns, xlPrevious)(2)

If Not DxCell Is Nothing Then
Sht.Range(DxCell.Offset(, 1), Sht.[IV1]). _
EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub
'-------------------------------------------------

Bonsour® Guy72 avec ferveur ;o))) vous nous disiez :

Non ça ne fonctionne pas, ça enlève tout, donc pas fiable.

Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String, Avant As Double, plage As Range
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 Laurent Longre par GeeDee"
'-------------------------------------------------------------
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
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("*", , xlFormulas, , 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("*", , xlFormulas, , 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
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


--
@+
;o)))

Bonjour et Merci Modeste
Là c'est fiable, je passe de 2174ko à 99ko.
Par contre, ça me supprime le format d'une colonne (BK1) et me change les
colonnes la largeur des colonnes de BK1 à CK1.
--
Cordialement
Guy

"Modeste" <nomail@nomail.net> a écrit dans le message de news:
%23K6YF%23sLJHA.4324@TK2MSFTNGP05.phx.gbl...
Bonsour® Guy72 avec ferveur ;o))) vous nous disiez :

Non ça ne fonctionne pas, ça enlève tout, donc pas fiable.

Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String, Avant As
Double, plage As Range
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 Laurent Longre par GeeDee"
'-------------------------------------------------------------
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
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("*", , xlFormulas, , 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("*", , xlFormulas, , 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
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


--
@+
;o)))

Bonjour et Merci aussi "michdenis"
ça fonctionne, je suis passé de 2174 ko à 93ko (6ko de moins que Modeste).
Parc contre même problème.
ça me supprime le format d'une colonne (BK1) et me change la largeur des
colonnes
de BK1 à CK1.
--
Cordialement
Guy
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
uj7mp7sLJHA.276@TK2MSFTNGP02.phx.gbl...

Il y a encore une petite coquille sur la procédure transmise.

Correction apportée : ceci devrait fonctionner.

'-------------------------------------------------
Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range
Dim DxCell As Range
Dim 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("*", _
, xlFormulas, , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)). _
EntireRow.Clear
Set DCell = Nothing
Set DxCell = Sht.Cells.Find("*", , xlFormulas, _
, xlByColumns, xlPrevious)(2)

If Not DxCell Is Nothing Then
Sht.Range(DxCell.Offset(, 1), Sht.[IV1]). _
EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub
'-------------------------------------------------