---

Excel VBA: Create Worksheets for Each Item in an Excel Table of Data

Got any Excel/VBA Questions? Free Excel Help.

CREATING WORKSHEETS FOR EACH ITEM IN A TABLE

I'm often asked how one could create x number of Worksheets where each one houses the data specific to each item in a table. Let's say we have data set out like shown below.

The screen shot is simply that of properly laid out table of data (A1:E12) where the first column is headed "Description". Underneath the "Description" header there are items, some of which exist more than once.

The task at hand is to create 1 Worksheet for each item (named as the item) and have all associated data on it.

You can download a working example of the code below here

Sub PagesByDescription()

Dim rRange As Range, rCell As Range

Dim wSheet As Worksheet

Dim wSheetStart As Worksheet

Dim strText As String



    Set wSheetStart = ActiveSheet

    wSheetStart.AutoFilterMode = False

    'Set a range variable to the correct item column

    Set rRange = Range("A1", Range("A65536").End(xlUp))

    

        'Delete any sheet called "UniqueList"

        'Turn off run time errors & delete alert

        On Error Resume Next

        Application.DisplayAlerts = False

        Worksheets("UniqueList").Delete

        

        'Add a sheet called "UniqueList"

        Worksheets.Add().Name = "UniqueList"

        

           'Filter the Set range so only a unique list is created

            With Worksheets("UniqueList")

                rRange.AdvancedFilter xlFilterCopy, , _

                 Worksheets("UniqueList").Range("A1"), True

                 

                 'Set a range variable to the unique list, less the heading.

                 Set rRange = .Range("A2", .Range("A65536").End(xlUp))

            End With

            

            On Error Resume Next

            With wSheetStart 

            	For Each rCell In rRange

                  strText = rCell

                 .Range("A1").AutoFilter 1, strText

                    Worksheets(strText).Delete

                    'Add a sheet named as content of rCell

                    Worksheets.Add().Name = strText

                    'Copy the visible filtered range _

                    (default of Copy Method) and leave hidden rows

                    .UsedRange.Copy Destination:=ActiveSheet.Range("A1")

                    ActiveSheet.Cells.Columns.AutoFit

                Next rCell

            End With

            

        With wSheetStart 

        	.AutoFilterMode = False

            .Activate

        End With

        

        On Error GoTo 0

        Application.DisplayAlerts = True

End Sub

 

See also:

 

Group Excel Worksheets/Sheets by Color

Hide Pivot Table Fields Pivot Items by Criteria

Excel: Get Underlying Hyperlink Address

Excel VBA: Create a List of Hyperlinks

Excel VBA: Gather User Data/Input via an InputBox

Inputbox in Excel VBA

Is Workbook Open/Workbook Exists/Worksheet Exists/Auto Filter/How Many Pages Printed

 

See also Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions.

 

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.

Gallery

---

• 
• 
• 
• 
• 
•