Create Multiple Worksheets from a Data Source Worksheet

wzvcfm

New Member
Joined
Mar 2, 2004
Messages
2
Hello Everyone.

I'm new to VBA and would like some pointers/assistance in the development of a macro that does/uses the following:

  • The workbook contains one worksheet with sales/returns information for each customer.
    Each customer, however, has four rows of data, one for each Sales Quarter.
    Create a new worksheet for EACH customer, along with carrying the four rows of data with it to the new worksheet.

An example of the data source worksheet is below:

CODE QTR YR SALES SALES EXT
575035 1 2003 6 $1,000.00
575035 2 2003 3 $400.00
575035 3 2003 3 $600.00
575035 4 2003 9 $900.00
112117 1 2003 12 $587.50
112117 2 2003 1 $15.00
112117 3 2003 5 $532.50
112117 4 2003 3 $415.00
112182 1 2003 8 $1,020.00
112182 2 2003 4 $535.00
112182 3 2003 7 $805.00
112182 4 2003 22 $2,097.50

I've tried the following code to simply add sheets based on the Code, but it errors at trying to name the second new worksheet.

Dim i As Integer
Dim Count As Integer
Dim Region As String
Dim ws As Worksheet


Code:
Sub Macro()

Cells(2, 1).Select
Selection.End(xlDown).Select
Count = ActiveCell.Row

Region = Cells(2, 1).Value

For i = 2 To Count

If Region <> Cells(i, 1).Value Then

Set ws = Worksheets.Add
ws.Name = Region

End If

Next i

End Sub

Any examples or specifics would be tremendously appreciated. This example should create three new worksheets, named respectively with each customer code, but my logic does nto do this.

Thanks,
WZVCFM
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

onlyadrafter

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
Hello,

This probably isn't the best way to do this but it does seem to work

Code:
Sub create_sheet()
For MY_ROWS = 2 To Range("a65536").End(xlUp).Row
    CUST_NAME = Range("A" & MY_ROWS).Value
On Error GoTo ERROR_HANDLER
    Rows(MY_ROWS).Copy
    Sheets("CUST " & CUST_NAME).Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("sHEET3").Activate

Next MY_ROWS
End

ERROR_HANDLER:
        Sheets.Add
        ActiveSheet.Name = "CUST " & CUST_NAME
Resume Next

End Sub

You will need to change Sheet3 to the name of your sheet with all the data on.

Is thisany use?
 

wzvcfm

New Member
Joined
Mar 2, 2004
Messages
2
Here's an update:

Code:
Dim i As Integer
Dim Count As Integer
Dim BeginRow As Integer
Dim EndRow As Integer
Dim Code As String
Dim ws As Worksheet
Dim mRange As Range

Sub Macro()

Cells(2, 1).Select
Selection.End(xlDown).Select
Count = ActiveCell.Row

BeginRow = 2

For i = 3 To Count

Code = Cells(i, 1).Value
Check = Cells(i + 1, 1).Value

If i <= Count Then
 If Check <> Code Then
 
     EndRow = i
    
     Worksheets("Sheet1").Activate
    
     Set mHeader = Range("A" & 1, "U" & 1).EntireRow
     mHeader.Select
     mHeader.Copy
    
     Set ws = ActiveWorkbook.Worksheets.Add
     ws.Name = ("Region" & Code)

     Worksheets("Region" & Code).Activate
     Worksheets("Region" & Code).Rows(1).Select
     Worksheets("Region" & Code).Paste

     Worksheets("Sheet1").Activate
     
     Set mRange = Range("A" & BeginRow, "U" & EndRow).EntireRow
     mRange.Select
     mRange.Copy
   
     Worksheets("Region" & Code).Activate
     Worksheets("Region" & Code).Rows(2).Select
     Worksheets("Region" & Code).Paste
   
     Worksheets("Sheet1").Activate
   
     BeginRow = i + 1
   
 End If
Else
Exit Sub
End If

Next i

End Sub

It seems to work ok, but is probably not the most efficient of processes.

WZVCFM
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,329
Messages
5,769,462
Members
425,551
Latest member
yeat

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top