Header Ads

ئاگادارى ...بۆ ڤيديوى تازە سەبسكرايبى چەناڵە تازەكەمان بكەن

Trulli
لێرە سەبسكرايب بكە

VBA Code to Split table in Excel sheet to multiple tables and add total to each table.




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


No comments

Powered by Blogger.