hi all,
in addition to the suggestions had already... try
Option Explicit
'========>>
Public Sub Tester()
'for each open workbook
Call Dimagrire
End Sub
'<<========
'========>>
Public Sub Tester2()
'for one open workbook
Call Dimagrire("Pippo.xls")
End Sub
'<<========
'---------------->>
'by Norman Jones
Public Sub Dimagrire( _
Optional sWbName As Variant)
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim iRow As Long
Dim iCol As Long
Dim blOK As Boolean
On Error GoTo XIT
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each WB In Workbooks
If IsMissing(sWbName) Then
blOK = True
Else
blOK = WB.Name = sWbName
End If
If blOK Then
For Each SH In WB.Worksheets
With SH
.DisplayPageBreaks = False
iRow = 0
iCol = 0
On Error Resume Next
iRow = LastRow(SH, .Cells)
iCol = LastCol(SH, .Cells)
On Error GoTo XIT
If iRow * iCol = 0 Then
.Columns.Delete
Else
If Not iRow = .Rows.Count Then
.Range(.Cells(iRow + 1, 1), _
.Cells(.Rows.Count, 1)). _
EntireRow.Delete
End If
If Not iCol = .Columns.Count Then
.Range(.Cells(1, iCol + 1), _
.Cells(1, .Columns.Count)). _
EntireColumn.Delete
End If
End If
Set Rng = .UsedRange
End With
Next SH
End If
Next WB
XIT:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'--------------->
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'--------------->
Function LastCol(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastCol = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'<<========
regards
r
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
