Excel 2007 Macro - HELP

Microsoft Microsoft excel 2007 full vers...
March 12, 2010 at 06:44:37
Specs: Windows XP
Can somebody please help? I have very little VB knowledge. I am trying to create a macro that reads a column of data (column A which is labeled Territory) and creates new worksheets for each distinct Territory. Everything would start from the first sheet of data and then need to be transposed to new worksheets under the respective Territory. There are 11 total columns of data; 10 distinct Territories; and multiple rows for each Territory. Thank you in advance for your help and assistance.

See More: Excel 2007 Macro - HELP

March 12, 2010 at 09:08:03

This macro takes each of the Territory names from column A on the source worksheet.
If there is no worksheet with that Territory name, it creates it.

The macro copies the data from each row to the worksheet with the same name (column A)

This is a one-time macro, meaning that it creates and copies all the data. If you add data to the end of the source worksheet, all the data on the source worksheet is appended to the existing Territory worksheets data.

Depending on how you use this workbook you could add code to clear each Territory worksheet before it is re-run or you could delete all the Territory worksheets before re-running it.

To run the macro, I suggest you add a button to your source worksheet
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 strSrcWSName As String
Dim rngSrcStart As Range
Dim rngSrcEnd As Range
Dim rngDestEnd As Range
Dim rngSrcCell As Range
Dim objWS As Object
Dim blnWSPresent As Boolean

On Error GoTo ErrHnd

'turn off screen updating to increase speed
'and remove screen flicker
Application.ScreenUpdating = False

'get name of this worksheet
strSrcWSName = ActiveSheet.Name

'set start row on source worksheet
Set rngSrcStart = Worksheets(strSrcWSName).Range("A2")

'set end row on source worksheet
Set rngSrcEnd = Worksheets(strSrcWSName). _
               Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'loop through each Territory name on source worksheet
For Each rngSrcCell In Worksheets(strSrcWSName).Range(rngSrcStart, rngSrcEnd)
    'test for presence of territory worksheet
    blnWSPresent = False
    On Error Resume Next
    Set objWS = Worksheets(rngSrcCell.Text)
    If Not objWS Is Nothing Then
        blnWSPresent = True
        Set objWS = Nothing
    End If
    On Error GoTo ErrHnd
    If blnWSPresent = False Then
        'worksheet does not exist, so create it
        ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
        'name new worksheet
        Worksheets(Worksheets.Count).Name = rngSrcCell.Text
    End If
    'find empty row after last row with data
    Set rngDestEnd = Worksheets(rngSrcCell.Text). _
                     Range("A" & CStr(Application.Rows.Count)).End(xlUp) _
                     .Offset(1, 0)
    'copy and paste data
    rngSrcCell.EntireRow.Copy Destination:=rngDestEnd
Next rngSrcCell

'turn screen updating on again
Application.ScreenUpdating = True
Exit Sub

'error handler
'turn screen updating on again
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().

Note that the macro assumes that your source data starts on row 2. If not edit this line

'set start row on source worksheet
Set rngSrcStart = Worksheets(strSrcWSName).Range("A2")

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 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.


Report •

March 12, 2010 at 10:17:12
Thank you...worked great. Only thing it didn't do was copy over the column headers. Not a big deal...can always copy and paste. Otherwise, you saved me a ton of work. Thank you again.

Report •
Related Solutions

Ask Question