VB for split data

Solved/Closed
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
Department | Name | Amount Spent |

In my file, there's one column specified different departments of a company,
with their money spent by the people,

I need separate it by different department to different sheet,
and also add a subtotal at the end.

How to write a macro for this??
manually is not ok becos it's often come up with a huge data.


many thx

1 reply

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
803
suppose your main data is in the sheet called "main"

the sample data is like this from A1 down and to right in this sheet "main"

Department Name Amount Spent
a q 1
s w 5
d e 3
a r 2
d t 4

open sheets with department name in this case a,s,d


now run this macro "test" (I have also added another macro for undoing for what you have done and to rerun the macro "test"
run the macro on the sample workbook(sheets "main", "a","s","d"
if it is ok you can use these in your original file

KEEP THE ORIGINAL FILE SAFELY SOMEWHERE FOR RETRIEVAL IF NECESSARY

Sub test()
Dim r As Range, r1 As Range, r2 As Range
Dim c2 As Range
Worksheets("main").Activate
Set r = Range(Range("a1"), Range("A1").End(xlDown))
Set r1 = Range("a1").End(xlDown).Offset(5, 0)
r.AdvancedFilter action:=xlFilterCopy, copytorange:=r1, unique:=True
Set r2 = Range(r1.Offset(1, 0), r1.End(xlDown))
For Each c2 In r2
r.CurrentRegion.AutoFilter field:=1, Criteria1:=c2.Value
r.CurrentRegion.Cells.SpecialCells(xlCellTypeVisible).Copy
Worksheets(c2.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
r.CurrentRegion.AutoFilter
Next c2
End Sub


Sub undo()
Dim j As Integer, k As Integer
j = Worksheets.Count
For k = 1 To j
If Worksheets(k).Name <> "main" Then
Worksheets(k).Cells.Clear
End If
Next k

End Sub