VB for split data
Solved/Closed
nicole
-
Mar 18, 2010 at 11:11 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Mar 19, 2010 at 07:08 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Mar 19, 2010 at 07:08 AM
Related:
- VB for split data
- Tmobile data check - Guide
- Vb editor download - Download - IDE
- Transfer data from one excel worksheet to another automatically - Guide
- How to be offline in whatsapp when data is on - Guide
- Data transmission cable - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Mar 19, 2010 at 07:08 AM
Mar 19, 2010 at 07:08 AM
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
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
