Results 1 to 6 of 6

Split worksheet into multiple worksheets

Threaded View

  1. #1
    Registered User
    Join Date
    08-12-2009
    Location
    Vancouver, Canada
    MS-Off Ver
    Excel 2003
    Posts
    7

    Smile Split worksheet into multiple worksheets

    This code splits a worksheet into multiple sheets (based on sales person in column A). But when it does it, it deletes the sheets and then re-creates them. However this messes with my formulas I have linked to the split sheets and turns them into #REF! errors.

    Can someone edit the code below to simply clear the cells and replace with the updated data? I will make sure blank sales person worksheets are set up in advance.

    Thanks!

    Sub Split_Worksheets()
    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
    Last edited by ashtanga; 08-12-2009 at 06:11 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1