# Create Multiple Worksheets from a Data Source Worksheet

#### wzvcfm

##### New Member
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

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

##### Well-known Member
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:
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
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

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

Replies
0
Views
441
Replies
16
Views
787
Replies
6
Views
634
Replies
3
Views
240
Replies
1
Views
351

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.

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.

### Which adblocker are you using?

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

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