Create Multiple Worksheets from a Data Source Worksheet

[wzvcfm]

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

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

 

[onlyadrafter]

Hello,

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

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]

Here's an update:

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