Thread: Reorder rows & copy to new sheet

Hi,
I need some VBA help in copying ranges from one sheet to another and pasting them on a predifined order. I have one worksheet that contains a large number of ranges with data on alphabetical order. Each entry on this sheet contains several rows of data and is identified by a name (e.g. entry "David" = rows 6:11, "Mark" = rows 13:18 and "Rose" = rows 20:25). I need to select certain ranges from this sheet and copy them on a predefined order on a different sheet (e.g 1) Rose, 2) David 3) Mark. The sequence is neither set by date, alphabetical order, nor by value. I have the order already predifined. I guess I could do this by specifiying the source sheet ranges and the destination ranges as well, but as I have over 2000 entries (each consisting of six rows), I need an efficient way to do it. Any help you could provide would be greatly appreciated.

Welcome to the forum.

Post a workbook.

First, duplicate the entries in cols A and B to eliminate blanks:

1. Select A3:B92, and do Edit > Go to > Special > Blanks

2. In the formula bar, type = then press the up arrow key, then press and hold the Ctrl key, then press Enter. Now all the blank cells copy the data above.

3. Select columns A:B, copy, and paste-special values. Now the formulas are gone.

If the above looks complex, it takes about 3 seconds ...

Then in column M, number the rows to maintain the original order. In M3 enter 1, in M4 2, and then drag to the bottom of the list (90).

Then make a list that defines the sort order -- essentially the list in your prior post, sans spaces and the numbers at left. Just the names in order. Put it on a separate sheet or anyplace out of the way. Select the list and name it, say, myOrder.

In N3 and copy down, MATCH(B3, myOrder, 0)

You'll notice that the name Dave appears in col B, but David appears in myOrder. Fix it one place or the other.

Then select A:M and sort by column N and M.

Try this. It will create the sheets as needed, or clear then and insert the new data if the "name" sheets already exist.
This macro assumes all the info for each person is grouped exactly as you've shown. It does not have anything in it that will work for the same name appearing multiple times in different sections down the data as you did not demonstrate that as a need.

Option Explicit

Sub SplitSheets()
'JBeaucaire  (8/23/2009)
'Split source data into separate sheets by names in column B
Dim LR As Long, FR As Long, BR As Long, i As Long, Val As String
Application.ScreenUpdating = False

'Set the data range
    LR = Range("C" & Rows.Count).End(xlUp).Row
'Set first row of first group
    FR = 3

'Loop through data
For i = 3 To LR
'Name being currently assessed
    Val = Cells(FR, "B")
    If Not Cells(i + 1, "B") = "" And Cells(i + 1, "B") <> Val Then
        'Set the bottom row of current set
            BR = i
        'Verify sheet exists, create if necessary
            If Not Evaluate("ISREF('" & Val & "'!A1)") Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Val
                Sheets("Source").Activate
            End If
        'Copy header row and data to new sheet
            With Sheets(Val)
                .Cells.Clear
                Rows(1).Copy .Range("A1")
                Rows(FR & ":" & BR).Copy .Range("A3")
            End With
        'Set first row of next group for next loop
            FR = i + 1
    End If
Next i
            
Application.ScreenUpdating = True
End Sub

Originally Posted by mernst

The predefined order would be the following:

1. Rose
2. David
3. Mark

4. Patricia
5. Rani
6. Paul

7. Karl
8. William
9. Rene

10. Olivia
11. Mary
12. Nancy
13. Peter

These ranges would need to be copied into a new sheet according to this predefined order.

My apologies, I misread the need, you want them all on ONE sheet in that order?

...as you can see the order is completely subjective...the workbook in reality contains thousands of records.

Now I'm lost. are the 13 names or are there 1000s?

Or is it just the 13 names with 1000s of rows of data data grouped as shown but having from 5-100s of rows in each group?

If it's 1000s of names, are you going to have an ordered list somewhere of the order in which want all of them to appear, like you've demonstrated for the first 13?

If you create a sheet called NAMES and put the names in the order you want them to appear in column A, then run this macro.

Note, you spelled "David" on your list of names, but in the data it was "Dave". You will have to correct your data or your name list for this to work.

Option Explicit

Sub SplitSheets()
'JBeaucaire  (8/23/2009)
'Reorder source data into order specified on a sheet called "Names"
Dim NR As Long, i As Long, r As Long, MyArr As Range
Application.ScreenUpdating = False

Sheets("Names").Activate
r = Range("A" & Rows.Count).End(xlUp).Row
Set MyArr = Range("A1:A" & r)

'Create/Clear Results sheet
    If Not Evaluate("ISREF(Results!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Results"
    End If
        Sheets("Source").Activate
        Sheets("Results").Cells.Clear
        Rows(1).Copy Sheets("Results").Range("A1")
        NR = 3

    For i = 1 To r
        On Error Resume Next
        Columns(2).Find(Sheets("Names").Range("A" & i).Text, After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        If Err <> 0 Then
            MsgBox "The name " & Sheets("Names").Range("A" & i).Text & " was not found, continuing..."
            Err = 0
        Else
            Rows(ActiveCell.Row & ":" & ActiveCell.Row + 5).Copy Sheets("Results").Range("A" & NR)
            NR = NR + 7
        End If
    Next i
            
Application.ScreenUpdating = True
End Sub

Very glad to hear that! Thanks for letting us know.

If that takes care of your need, be sure to EDIT your original post, click Go Advanced and mark the PREFIX box [SOLVED].

(if the PREFIX box is no longer available, just add SOLVED to the start of the title)

(Also, use the blue "scales" icon in our posts to leave Reputation Feedback, it is appreciated)