Merge Multiple Sheets Into One Worksheet & Receive Subtotal
Excel users usually need to merge multiple worksheets into a
single main worksheet, so that the data can be analyzed quickly and easily.
In this template ago, we combined all sheets into one sheet :
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Grand_Table"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Last = FindLastRow(Sheets(1))
Selection.Copy
With Sheets(1).Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Next
...
Worksheets.Add
Sheets(1).Name = "Grand_Table"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Last = FindLastRow(Sheets(1))
Selection.Copy
With Sheets(1).Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Next
...
Later, we sorted in ascending order the data in created main sheet and received subtotal of column that we
selected :
Sheets("Grand_Table").UsedRange.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=True, SummaryBelowData:=True
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=True, SummaryBelowData:=True
"TotalList: = Array (6)" expression in subtotal codes indicates Column 6.
We highlighted the subtotal cells by coloring them :
For Each Rng In Selection
If Rng.HasFormula Then
With Rng
.Interior.ColorIndex = 37
.Font.Bold = True
End With
End If
Next
If Rng.HasFormula Then
With Rng
.Interior.ColorIndex = 37
.Font.Bold = True
End With
End If
Next
Especially with this template, the months of year
are merged into a single sheet, and subtotals can be received and analyzed
yearly data easily.
No comments:
Post a Comment