Create a tab for each unique cell

[Jaffabfc]

Morning Everyone,

Tried searching on the forum and online but not finding anything.

I have a lot of data in a tab called "All Items Planner" and in column D i have several thousand cells populated (range changes daily).
In Column D there could be around 20-100 unique lots of data.

Is it possible to create a seperate cell automatically for each unique cell?

Also is it possible to do without a Macro, lots of Macros get removed by the anti-virus where i work and i struggle to keep them active.

Thanks

 

[Jaffabfc]

There is a method for creating the sheets without code but it can be a bit long winded:

List the names of the sheets to be created with the heading 'Sheets' in a column.
Create a pivot table from the list you just created.
Drop the 'Sheets' column of the pivot table into the filter section in the field selector.
Go to the 'PivotTable Analyze' section in the ribbon.
Click on the drop down for the 'Options' of the pivot table (Just under the pivot table name)
Select the option 'Show report filter pages'

It will create the sheets with a small pivot table on each sheet.

At that point you would be able to select all of the newly created sheets as an array (multi select the sheets) and then delete the pivot table from them.

You will be left with all of the sheets you need

Thanks for this.

I want to have as little input as possible when creating the file but it is good to know the above.

thanks again

 

[AlanY]

check if this work for you

Sub CreateNewSheets()
    Dim wsList As Worksheet
    Dim wsTemplate As Worksheet
    Dim cell As Range

    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")

    For Each cell In wsList.Range("A1:A5")
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        wsTemplate.Cells.Copy ActiveSheet.Cells
    Next cell
End Sub

This macro first sets variables for the 'List' and 'Template' sheets, then loops through the range A1:A5 in the 'List' sheet. For each cell in the range, it creates a new sheet with the name of the cell value and copies the content from the 'Template' sheet to the new sheet. Finally, it moves to the next cell in the range until all cells have been processed.

 

[Jaffabfc]

Hi,

Thats seems to have worked thanks.
Only issue i get is the range (chaged to A2:A1500) because it can vary on a daily basis i get an error at the end if its less than 1500 cells.

Is there a way of making it not bring up an error and just complete the macro?

thanks

 

[AlanY]

try this

Sub CreateNewSheets()
    Dim wsList As Worksheet
    Dim wsTemplate As Worksheet
    Dim cell As Range
    Dim lastRow As Long

    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")

    lastRow = wsList.Cells(Rows.Count, "A").End(xlUp).Row ' Get the last non-empty row in column A

    For Each cell In wsList.Range("A1:A" & lastRow)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        wsTemplate.Cells.Copy ActiveSheet.Cells
    Next cell
End Sub

 

[Jaffabfc]

try this

Sub CreateNewSheets()
    Dim wsList As Worksheet
    Dim wsTemplate As Worksheet
    Dim cell As Range
    Dim lastRow As Long

    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")

    lastRow = wsList.Cells(Rows.Count, "A").End(xlUp).Row ' Get the last non-empty row in column A

    For Each cell In wsList.Range("A1:A" & lastRow)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        wsTemplate.Cells.Copy ActiveSheet.Cells
    Next cell
End Sub

Ive entered the below and its thrown it all out.

The other sheet is called Seperate Vendor Codes
[/CODE]

Sub CreateNewSheets()
    Dim wsList As Worksheet
    Dim wsTemplate As Worksheet
    Dim cell As Range
    Dim lastRow As Long

    Set wsList = ThisWorkbook.Worksheets("Seperate Vendor Codes")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")

    lastRow = wsList.Cells(Rows.Count, "A").End(xlUp).Row ' Get the last non-empty row in column A

    For Each cell In wsList.Range("A1:A" & lastRow)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        wsTemplate.Cells.Copy ActiveSheet.Cells
    Next cell
End Sub

 

[AlanY]

Ive entered the below and its thrown it all out.

The other sheet is called Seperate Vendor Codes
[/CODE]

Sub CreateNewSheets()
    Dim wsList As Worksheet
    Dim wsTemplate As Worksheet
    Dim cell As Range
    Dim lastRow As Long

    Set wsList = ThisWorkbook.Worksheets("Seperate Vendor Codes")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")

    lastRow = wsList.Cells(Rows.Count, "A").End(xlUp).Row ' Get the last non-empty row in column A

    For Each cell In wsList.Range("A1:A" & lastRow)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
        wsTemplate.Cells.Copy ActiveSheet.Cells
    Next cell
End Sub

unfortunately, you can't have spaces in the sheet name "Seperate Vendor Codes"

 

[Jaffabfc]

unfortunately, you can't have spaces in the sheet name "Seperate Vendor Codes"

thats weird, i altered the original code and it worked. i will try and change it to List and see if it works.

thanks

 

[Jaffabfc]

sorted, i had changed a formula in the "List" which brought up an error of #SPILL so that wouldnt work.
thanks

 

[AlanY]

unfortunately, you can't have spaces in the sheet name "Seperate Vendor Codes"

not quite sure where I got that from, may be old version of excel, may be not