VB for split data [Solved/Closed]

Report
-
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
-
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
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
800
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

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!