In this Excel tutorial, we'll dive into the world of VBA coding to
automate the process of splitting a large table into multiple tables.
If you've ever wondered how to efficiently manage and organize your data in Excel,
this tutorial is for you!
Sub SplitTable()
Dim wss As Worksheet
Dim wst As Worksheet
Dim tbs As ListObject
Dim newTable As ListObject
Dim ids As Collection
Dim cel As Range
Dim rt As Long
Dim id As Variant
Application.ScreenUpdating = False
Set wss = ActiveSheet
Set tbs = wss.Range("A1").ListObject
Set ids = New Collection
On Error Resume Next
For Each cel In tbs.ListColumns("Employee ID").DataBodyRange
ids.Add Key:=CStr(cel.Value), Item:=cel.Value
Next cel
On Error GoTo 0
Set wst = Worksheets.Add(After:=wss)
wst.Range("Z1").Value = "Employee ID"
rt = 1
For Each id In ids
tbs.HeaderRowRange.Copy Destination:=wst.Range("A" & rt)
wst.Range("Z2").Value = id
tbs.Range.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wst.Range("Z1:Z2"), _
CopyToRange:=wst.Range("A" & rt + 1)
wst.Range("A" & rt).CurrentRegion.Rows(1).Delete Shift:=xlShiftUp
' Add the table and get a reference to it
Set newTable = wst.ListObjects.Add(Source:=wst.Range("A" & rt).CurrentRegion)
' Enable total row for the new table
newTable.ShowTotals = True
rt = rt + wst.Range("A" & rt).CurrentRegion.Rows.Count + 1
Next id
wst.Range("Z1:Z2").Clear
wst.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Post a Comment