delete blank rows in an multiple xcel sheet using macros
Sub DeleteBlankRows()
Dim Rw As Long, RwCnt As Long, Rng As Range
Application.ScreenUpdating = False
Application.Calculation =
xlCalculationManual
On Error Goto Exits:
If Selection.Rows.Count
> 1 Then
Set Rng
= Selection
Else
Set Rng
= Range(Rows(1),
Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
End If
RwCnt = 0
For Rw =
Rng.Rows.Count To 1 Step
-1
If Application.WorksheetFunction.CountA(Rng.Rows(Rw).EntireRow)
= 0 Then
Rng.Rows(Rw).EntireRow.Delete
RwCnt = RwCnt + 1
End If
Next Rw
Exits:
Application.ScreenUpdating = True
Application.Calculation =
xlCalculationAutomatic
End Sub
----------------------------------------------------------------------------
delete blank columns in an multiple xcel sheet using macros including headers
Sub DeleteBlankColumns()
Sub DeleteBlankColumns()
Dim Col As Long, ColCnt As Long, Rng As Range
Application.ScreenUpdating = False
Application.Calculation =
xlCalculationManual
On Error Goto Exits:
If
Selection.Columns.Count > 1 Then
Set Rng
= Selection
Else
Set Rng
= Range(Columns(1),
Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
End If
ColCnt = 0
For Col = Rng.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Columns(Col ).EntireColumn) = 0 Then
Rng.Columns(Col ).EntireColumn.Delete
ColCnt = ColCnt + 1
End If
Next Col
Exits:
Application.ScreenUpdating = True
Application.Calculation =
xlCalculationAutomatic
End Sub
---------------------------------------------------------------
delete blank rows in an multiple xcel sheet using macros excluding headers
---------------------------------------------------------------
delete blank rows in an multiple xcel sheet using macros excluding headers
Sub Workbook_Open()
Dim i As Integer
For i =
1 To Worksheets.Count
Sheets(i).Select
Dim Col
As Long, ColCnt As Long, Rng As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On
Error GoTo Exits:
If Selection.Columns.Count > 1 Then
Set Rng = Selection
Else
Set Rng = Range(Columns(1),
Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
End If
ColCnt = 0
For Col
= Rng.Columns.Count To 1 Step -1
If ((Application.WorksheetFunction.CountA(Rng.Columns(Col ).EntireColumn)
= 0) Or (Application.WorksheetFunction.CountA(Rng.Columns(Col ).EntireColumn) = 1)) Then
Rng.Columns(Col ).EntireColumn.Delete
ColCnt = ColCnt + 1
End If
Next Col
Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Next i
End Sub
--------------------------------------------------------------------------
How to
use:
|
|
Test
the code:
|
|