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

< Back to Search results

 Category: [Excel]  Demo Available 

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


Got any Excel/VBA Questions? Free Excel Help.


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



        '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


                    '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")


                Next rCell

            End With


        With wSheetStart 

        	.AutoFilterMode = False


        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.


stars (0 Reviews)