Hello everyone,
I use this macro to delete all the data except for tables in my workbook. the macro deletes only the first worksheet. I need it run through worksheets. what change do i need to make to make it work ?
Thanks
I use this macro to delete all the data except for tables in my workbook. the macro deletes only the first worksheet. I need it run through worksheets. what change do i need to make to make it work ?
Thanks
VBA Code:
Option Explicit
Sub deleteExceptTable()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Dim urg As Range: Set urg = ActiveSheet.UsedRange
Dim trg As Range: Set trg = ActiveSheet.ListObjects(1).Range
Dim drg As Range
Dim lSize As Long
Dim cCount As Long
' Left
lSize = trg.Column - urg.Column
If lSize > 0 Then
Set drg = urg.Columns(1).Resize(, lSize)
End If
' Right
cCount = urg.Column + urg.Columns.Count - trg.Column - trg.Columns.Count
If cCount > 0 Then
Set drg = CombinedRange(drg, _
urg.Columns(lSize + trg.Columns.Count + 1).Resize(, cCount))
End If
Dim rCount As Long
' Top
rCount = trg.Row - urg.Row
If rCount > 0 Then
Set drg = CombinedRange(drg, _
Cells(urg.Row, trg.Column).Resize(rCount, trg.Columns.Count))
End If
' Bottom
rCount = urg.Row + urg.Rows.Count - trg.Row - trg.Rows.Count
If rCount > 0 Then
Set drg = CombinedRange(drg, Cells(trg.Row + trg.Rows.Count, _
trg.Column).Resize(rCount, trg.Columns.Count))
End If
If Not drg Is Nothing Then
drg.delete
End If
Next I
End Sub
Function CombinedRange( _
ByVal BuiltRange As Range, _
ByVal AddRange As Range) _
As Range
If BuiltRange Is Nothing Then
Set CombinedRange = AddRange
Else
Set CombinedRange = Union(BuiltRange, AddRange)
End If
End Function