Menu
0
Thanks

A few words of thanks would be greatly appreciated.

# Excel/VBA - A macro to split data

Microsoft Excel is a Microsoft office software application, which features graphic tools, pivot tables, macro programming called visual basic for applications (VBA) and calculations. It has a widely applied worksheet for these platforms. Visual basics for applications programming aspects allow users to employ a variety of numerical methods and report the results to the worksheets. In the Excel application, macros are written using VBA code. For those who cannot write VBA code, Excel provides a feature called macro recorder, which records activities of the user and creates VBA code, which will be in the form of a macro. Macros help to split data to different worksheets and eliminate repetitive tasks.

## Issue

Department | Name | Amount Spent |

In my file, there's one column which specifies the different departments of a company, with the money spent by the people. I need to separate it, by department to different sheets and also add a subtotal at the end.

How to write a macro for this??
Manually is not OK because it often comes up with a huge data.

## Solution

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

Macro 1:

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

Macro 2:

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

## Note that

Thanks to venkat1926 for this tip on the forum.
0
Thanks

A few words of thanks would be greatly appreciated.

Ask a question
CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jean-François Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.

## Related

This document, titled « Excel/VBA - A macro to split data », is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).

## 0 Comments

Recommended

DON'T MISS

TRENDING GAMES & APPS
• Religion

• Video games

• Video games

• Video games

• Video games

• Apps

• Professional

• Health

• Health

• Video Calls

### Zoom

• Social Networking