Results 1 to 4 of 4
  1. #1
    Join Date
    Jan 2004
    Posts
    58

    Unanswered: Divide up Worksheet

    I have an excel worksheet layed out as follows (numbers = row):

    1 - Section Title
    2 - Section data 1
    3 - Section data 2
    4 - Section data 3
    etc
    20 - blank
    21 - Section Title
    22 - section data 1
    etc

    all the different sections are divided by a blank row.
    There are no blank rows within each section.
    Each section contains a different number of rows.
    Each section has multiple columns.

    What I want to do is divide up this one worksheet so each section is in its own separate worksheet with the same name as the Section Title.

    Is there a quick and easy way to do this without having to spend ages cutting and pasting?

  2. #2
    Join Date
    Jan 2004
    Location
    Aberdeen, Scotland
    Posts
    1,067
    Hi HilcrRWise

    Here's a bit of code that will do this for you

    Code:
    Sub DivideWorksheet()
        Dim Lastrow As Long
        Dim r1 As Range
        Dim r2 As Range
        Dim wsData As Worksheet
        
        'Initalise Variables
        Set wsData = ActiveSheet
        Lastrow = Range("A" & Rows.Count).End(xlUp).Row
        Set r1 = Range("A" & Lastrow)
        
        'Create new worksheet for each block of characters
        'and Cut the data into them
        Do Until r1 = Range("A1")
            Set r1 = wsData.Range("A" & Lastrow)
            Set r2 = r1.End(xlUp)
            
            Worksheets.Add
            ActiveSheet.Name = r2.Value
            
            wsData.Activate
            
            Range(r1, r2).Cut Worksheets(r2.Value).Range("A1")
            Lastrow = Range("A" & Rows.Count).End(xlUp).Row
        Loop
        
        'reorder Worksheets
        For i = Worksheets.Count To 1 Step -1
            If Not Worksheets(i) Is wsData Then
                Worksheets(i).Move before:=wsData
            End If
        Next i
        
        'get rid of Object Variables
        Set r1 = Nothing
        Set r2 = Nothing
        Set wsData = Nothing
    End Sub
    HTH
    Dave

  3. #3
    Join Date
    Jan 2004
    Posts
    58
    Thanks for the reply.

    Unfortunately the code you provided only copies the first column of the section data. How do I modify the code to handle multiple columns.

  4. #4
    Join Date
    Jan 2004
    Location
    Aberdeen, Scotland
    Posts
    1,067
    sorry about that replace this line

    Range(r1, r2).Cut Worksheets(r2.Value).Range("A1")
    with
    Range(r1,r2).Entirerow.Cut Worksheets(r2.Value).Range("A1")

    This will cut the entire row
    if you need only a certain section you can change the code to
    Range("A" & r1.row & ":N" & r2.row).Cut Worksheets(r2.Value).Range("A1")

    will cut the range from column A to Column N for your rows

    Dave

Posting Permissions

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