Excel 2007 Macro To Copy Rows to Tabs

Microsoft Office excel 2007 home & stude...
June 3, 2010 at 09:22:35
Specs: Windows XP
Hey guys,

I need some help. All of my data is in Sheet one listed as:
Column A - Name
Column B - Date
Column C - Amount Pledged
Column D - Amount Received
Column E - Balance Owed

All of the headers of those columns would be the same on each worksheet. What I need help with is that I need to create new worksheets for each new year in the Sheet 1 data. For example, If column B is 06/01/2006 then it needs to go to the "2006" sheet. 07/05/2008 would need to go the the "2008" worksheet and so on. This project is huge. Nearly 8300 lines. Any help would be greatly appreciated. Thanks in advance.


See More: Excel 2007 Macro To Copy Rows to Tabs

Report •


#1
June 3, 2010 at 12:07:47
Do you know how to write/modify VBA code?

The code in this thread does pretty much what you are asking for, although the ranges it uses as the list for the new sheets is different than yours.

Let us know if this helps...

http://www.computing.net/answers/of...


Report •

#2
June 3, 2010 at 12:27:54
I tried it and modified it. Worked like it was suppose to except I need it to sort through the year, i.e. 05/05/2007, 04/02/2008, and sort the year into a different sheet. Then every year that corresponds with it would be placed in the same worksheet based on the year. Hopefully this isn't too confusing :-). I really appreciate your help. The project is headed in the right direction.

Report •

#3
June 3, 2010 at 13:21:37
Not sure what you modified it to do, since you didn't post your modifications, but I was able to modify it to loop through the dates in Column B, extract the year, create a sheet for that year if it doesn't already exist, and copy year specific rows to the next available row in the corresponding sheet.

Note: the values in Column B must be recognized as dates by Excel.

Remember to thank Humar, since he wrote the original code.

Option Explicit

Public Sub MoveToTab()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim strYear As String

On Error GoTo ErrHnd

With Worksheets("Sheet1")
    'set start as Q2 i.e., after heading row in column B
    Set rngStart = .Range("B1")
    'set end - last used row in column B
    Set rngEnd = .Range("B65534").End(xlUp)
    
    'loop through cells in column B
    For Each rngCell In Range(rngStart, rngEnd)
    'Extract year to use as Sheet name
      strYear = Application.WorksheetFunction.Text(Year(rngCell), "####")
        'test if tab exists
        On Error Resume Next
        If Not Worksheets(strYear).Name <> "" Then
            On Error GoTo ErrHnd
            'No worksheet of this name - so create one and copy row
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = strYear
            rngCell.EntireRow.Copy Destination:=Worksheets(strYear).Range("A1")
            Else
            On Error GoTo ErrHnd
            'worksheet exists
            'copy row to end of used range
            rngCell.EntireRow.Copy Destination:=Worksheets(strYear).Range("A1") _
                    .Offset(Worksheets(strYear).UsedRange.Rows.Count, 0)
        End If
    Next rngCell
End With
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub


Report •

Related Solutions

#4
June 3, 2010 at 13:26:33
Just noticed that you need the column headers added to each new sheet.

Is that something you can handle on your own or should I provide the code for that also?

Hint: You should be able to just copy the column header row from Sheet1 after a new sheet is created. Once the sheet exists, that section of code is skipped, so you'll only copy the headers once.


Report •

#5
June 3, 2010 at 13:39:09
Man, i appreciate your help so much. Worked like a charm. Also, if you don't mind, the code of the headers would be helpful. Another question if you don't mind. If the Sheet 1 data was to ever be updated and the list of people was to grow (which it's going to) and i compiled and ran the code, is there a way to not duplicate the rows that have already been entered in the worksheets? Everytime I hit compile/run, it duplicates the number of people in each spreadsheet the number of times I hit the button. I just really want to thank you for your help and patience. Hope you have a great day.

Sho


Report •

#6
June 3, 2010 at 14:57:30
This version of the code copies the Column Header row when it creates a new sheet.

The way it handles "new additions" is pretty brute force. It simply deletes every sheet except for Sheet1 (which is assumed to be the first sheet in the workbook) and then re-creates each one and copies all of the data over again.

This is fine unless you are changing the data on the "yearly" sheets once it placed there by the code. If you need to copy just the new data over, then we would need to determine what is new and what is not each time the code is run. That's doable, but a bit more work.

Option Explicit

Public Sub MoveToTab()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim strYear As String
Dim shtNum As Integer

On Error GoTo ErrHnd
'Turn off screen updating so changes aren't seen by user
 Application.ScreenUpdating = False
'Delete Existing Year Sheets, no Alert given to user
 Application.DisplayAlerts = False
  For shtNum = Sheets.Count To 2 Step -1
   Sheets(shtNum).Delete
  Next
'Re-enable Alerts
 Application.DisplayAlerts = True
With Worksheets("Sheet1")
    'set start as Q2 i.e., after heading row in column B
    Set rngStart = .Range("B2")
    'set end - last used row in column B
    Set rngEnd = .Range("B65534").End(xlUp)
    
    'loop through cells in column B
    For Each rngCell In Range(rngStart, rngEnd)
    'Extract year to use as Sheet name
      strYear = Application.WorksheetFunction.Text(Year(rngCell), "####")
        'test if tab exists
        On Error Resume Next
        If Not Worksheets(strYear).Name <> "" Then
            On Error GoTo ErrHnd
            'No worksheet of this name - so create one and copy row
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = strYear
            Sheets(1).Cells(1).EntireRow.Copy _
                    Destination:=Worksheets(strYear).Range("A1")
            rngCell.EntireRow.Copy _
                    Destination:=Worksheets(strYear).Range("A2")
            Else
            On Error GoTo ErrHnd
            'worksheet exists
            'copy row to end of used range
            rngCell.EntireRow.Copy _
                    Destination:=Worksheets(strYear).Range("A1") _
                    .Offset(Worksheets(strYear).UsedRange.Rows.Count, 0)
        End If
    Next rngCell
End With
 Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.ScreenUpdating = True
End Sub




Report •

#7
June 3, 2010 at 15:05:56
Man, this has really helped me. Again thanks for taking the time out of your schedule to help me. I really appreciate it. I think this is going to do it and make it work. Again, thank you so much.

Report •

#8
June 3, 2010 at 15:16:51
So I just got done testing it against the the data in the workbook and it only carries over one for each year. Is there a way to get it to carry over all of the ones that need to be carried over? Sorry to keep bothering you with this.

Report •

#9
June 3, 2010 at 16:31:38
Hi,

Here is the macro with some modifications:
1. The number of rows has been revised to allow all rows in Excel 2007 to be used (it still works in excel 2003)
2. When new worksheets are created, the heading row is automatically created.
3. After the first time the code is run, the word 'Copied' is added after the last entry.
4. If new data is added after the row containing the word 'Copied', the next time the code is run, only the new data is moved to the 'year' worksheets.
5. Screen updating is turned off to improve speed during processing.
6. The code is now 'attached' to an embedded button on the 'Sheet1' worksheet.

To add the button and the code:
From the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)

In Developer - Controls select Insert and choose the button icon.
Draw the button on the worksheet
In the 'Assign Macro' dialog box select 'New'

In the code window that opens enter this:

Option Explicit

Private Sub Button1_Click()

Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim strYear As String
Dim rngSearch As Range
Dim rngFind As Range

On Error GoTo ErrHnd

'stop screen updating to increase speed
Application.ScreenUpdating = False

With Worksheets("Sheet1")
    'set start as row after cell with 'Copied' in it
    'if 'Copied' not found use B2 i.e., after heading row in column B
    Set rngSearch = Range("B2:B" & CStr(Application.Rows.Count))
    Set rngFind = rngSearch.Find("Copied", LookIn:=xlValues)

    If rngFind Is Nothing Then
        'Copied not found - so start at B2
        Set rngStart = .Range("B2")
        Else
        'Copied found
        'set start to row after 'Copied'
        Set rngStart = rngFind.Offset(1, 0)
        'delete the row containing 'Copied'
        rngFind.EntireRow.Delete
    End If
    
    'set end - last used row in column B
    Set rngEnd = .Range("B" & CStr(Application.Rows.Count)).End(xlUp)
    
    'loop through cells in column B
    For Each rngCell In Range(rngStart, rngEnd)
    'Extract year to use as Sheet name
      strYear = Application.WorksheetFunction.Text(Year(rngCell), "####")
        'test if tab exists
        On Error Resume Next
        If Not Worksheets(strYear).Name <> "" Then
            On Error GoTo ErrHnd
            'No worksheet of this name - so create one
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = strYear
            'copy header row then and copy row of data
            .Range("A1").EntireRow.Copy Destination:=Worksheets(strYear).Range("A1")
            rngCell.EntireRow.Copy Destination:=Worksheets(strYear).Range("A2")
            Else
            On Error GoTo ErrHnd
            'worksheet exists
            'copy row to end of used range
            rngCell.EntireRow.Copy Destination:=Worksheets(strYear).Range("A1") _
                    .Offset(Worksheets(strYear).UsedRange.Rows.Count, 0)
        End If
    Next rngCell
    'flag end of copied data (in column B)
    rngEnd.Offset(1, 0).Value = "Copied"
End With

'restore screen updating
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'restore screen updating
Application.ScreenUpdating = True
End Sub

Note that Sub Button1_Click() and End Sub will already be present, so don't duplicate them. Option explicit goes before Sub Button1_Click().

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

Right click the button and Edit the name to something meaningful

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

After selecting any cell, the new command button should now respond to a click and run the macro.

Regards


Report •

#10
June 3, 2010 at 16:45:02
Earlier you said:

Man, i appreciate your help so much. Worked like a charm

Now you are saying it doesn't work? Is it the new version that doesn't work or did the original not really work like you said it did?

I ran the code in Response 6 against 8600 dates in Sheet1 Column B ranging from 2006 to 2014 and it copied hundreds of dates to each sheet, with each sheet only containing dates for the year that matched the sheet name.

Since I can't see your workbook from where I'm sitting I can't tell you why it doesn't work for you.

Are you sure that Excel is recognizing the dates as dates?


Report •

#11
June 3, 2010 at 19:47:09
Derby, everything works now. I was copying the information into the spreadsheet wrong. I apologize for the confusion. Humar, I really appreciate you and Derby for taking time to help me with this problem. Everything works now :-). Again thanks to both of you.

Report •

#12
November 22, 2010 at 11:02:57
I think this is what I'm looking for (or a variation of it) unfortunately it's so far over my head I can't quite tell! lol I have a main spreadsheet with columns that read something similar to: First Name; Last Name; SIN; Start Date; End Date; Birth Date; Date Received; Tuition Amount etc.

The list is constantly updated. I'm looking for a way that will (when the main sheet is updated) will automatically take the "date received" and pull the month, it will then copy the SIN, First Name, Last Name and Tuition amount and put it into a different spreadsheet, into the proper tab.

If the month in "date received" from the main spreadsheet is September, then it should pull that row's data and copy it into the second spreadsheet into the tab named September. ... does that make sense? I hope I'm explaining that right!
Thank you
Heidi


Report •

Ask Question