Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

copy rows to new worksheet on change of value

Posted on 2014-08-08
1
Medium Priority
?
198 Views
Last Modified: 2014-08-08
I need a macro that would take the value column A and upon a change it would copy each group to a new worksheet.  

ie
Apple
Apple
Apple
Pear
Pear
Pear
Orange
Orange

So all the apple rows would go to a new workbook called apple and all the pear rows would go to a new workbook called pear and all the orange rows would go a new workbook called orange. Also it would copy the first row as the headers for each file.

Thanks,
Montrof
0
Comment
Question by:montrof
1 Comment
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 2000 total points
ID: 40249699
I'm not sure what "change" you would expect or require to make this happen, but in the meantime, I've set up a workbook with a button to activate a subroutine that will sort on the values in column A and move all values in the related rows to new sheets.  Each sheet preserves the column headings on the source sheet and the sheet name will be the value from column A.  
Sub Split_To_Multiple_Sheets()
    Dim intLR As Long
    Dim c As Integer
    Dim rng As Range
    Dim cl As Object
    Dim strNewSh As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    intLR = Cells.SpecialCells(xlLastCell).Row
    
    Sheets("Master").Activate
    ActiveWorkbook.Worksheets("Master").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Master").Sort.SortFields.Add Key:=Range("A2:A" & intLR) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Master").Sort
        .SetRange Range("A1:Z" & intLR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Set rng = Range("A2:A" & intLR)
    For Each cl In rng
        If cl.Value <> cl.Offset(1, 0).Value Then 'create sheet
            strNewSh = cl.Value
            Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
            ActiveSheet.Name = strNewSh
            Sheets("Master").Activate
            Range("A1:Z1").Copy
            Sheets(strNewSh).Activate
            ActiveSheet.Paste
            Sheets("Master").Activate
            Range("A" & cl.Row - c & ":Z" & cl.Row).Copy
            Sheets(strNewSh).Activate
            Range("A2").Select
            ActiveSheet.Paste
            Range("A1:Z1").EntireColumn.AutoFit
            Application.CutCopyMode = False
            Range("A2").Select
            Sheets("Master").Activate
            c = 0
        Else
            c = c + 1
        End If
    Next cl
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Done."
End Sub

Open in new window


For simplicity, I've limited this to columns A through Z; if you need something dynamic - or more columns - let me know.

Regards,
-Glenn
EE-SplitMultipleSheets.xlsm
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question