[VBA] How could I split data into multiple sheets by specific row number?

[ffffff]

Hi guys,

I just got a bunch of data in the same column.

For the row number below, those are not necessary for my further action. [TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64, align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]17[/TD]
[/TR]
[TR]
[TD="align: right"]50[/TD]
[/TR]
[TR]
[TD="align: right"]83[/TD]
[/TR]
[TR]
[TD="align: right"]122[/TD]
[/TR]
[TR]
[TD="align: right"]159[/TD]
[/TR]
[TR]
[TD="align: right"]189[/TD]
[/TR]
[TR]
[TD="align: right"]217[/TD]
[/TR]
[TR]
[TD="align: right"]234[/TD]
[/TR]
[TR]
[TD="align: right"]267[/TD]
[/TR]
[TR]
[TD="align: right"]306[/TD]
[/TR]
[TR]
[TD="align: right"]343[/TD]
[/TR]
[TR]
[TD="align: right"]376[/TD]
[/TR]
[TR]
[TD="align: right"]411[/TD]
[/TR]
[TR]
[TD="align: right"]427[/TD]
[/TR]
[TR]
[TD="align: right"]461[/TD]
[/TR]
[TR]
[TD="align: right"]495[/TD]
[/TR]
[TR]
[TD="align: right"]535[/TD]
[/TR]
[TR]
[TD="align: right"]573[/TD]
[/TR]
[TR]
[TD="align: right"]605[/TD]
[/TR]
[TR]
[TD="align: right"]635[/TD]
[/TR]
[TR]
[TD="align: right"]653[/TD]
[/TR]
[TR]
[TD="align: right"]687[/TD]
[/TR]
[TR]
[TD="align: right"]728[/TD]
[/TR]
[TR]
[TD="align: right"]766[/TD]
[/TR]
[TR]
[TD="align: right"]800[/TD]
[/TR]
</tbody>[/TABLE]

And I want to extract data from row 3 to 16 as one sheet, 18 to 49 for another sheet, 51 to 82, 84 to 121.......
Please suggest VBA code for spliting those data to different worksheets.

Please help. Thank you!

 

[Joe4]

Welcome to the Board!

Where is this list of numbers going to be?
Is it going to be on a sheet somewhere (if so, where and what sheet/range will it be found in)?

What sheet will have the data range you want to copy to new sheets?

And what naming convention do you want the sheets to have?

 

[ffffff]

For those row numbers, they all located at Sheet1 and their range are G1:G26.

If possible, for those new sheets extracted, could it be possible to entitle them as total number of new sheets divided by 2 and name those new sheets in order.

Say the total number of new sheets = 20
then
the new name of those sheets would be
1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8,9,10

 

[ffffff]

Welcome to the Board!

Where is this list of numbers going to be?
Is it going to be on a sheet somewhere (if so, where and what sheet/range will it be found in)?

What sheet will have the data range you want to copy to new sheets?

And what naming convention do you want the sheets to have?

Actually those new sheets should be a1,a2,a3.....
b1,b2,b3.....

 

[Joe4]

OK, so Sheet1 has the row numbers in Range G1:G26.
Which sheet actually contains the data that you want to copy over to the new sheets?

 

[ffffff]

OK, so Sheet1 has the row numbers in Range G1:G26.
Which sheet actually contains the data that you want to copy over to the new sheets?

Also Sheet1.

 

[Joe4]

So, do you want to move over the ENTIRE row, or just certain columns?
Because if you are moving over the entire rows, and the row list is in G1:G26, those row numbers will get picked up in your first few moves (2, 17, 50).

Also, do you actually want to move the data (meaning remove it from the original sheet), or just copy it to the other sheets (and leave the original list intact)?

 

[ffffff]

So, do you want to move over the ENTIRE row, or just certain columns?
Because if you are moving over the entire rows, and the row list is in G1:G26, those row numbers will get picked up in your first few moves (2, 17, 50).

Also, do you actually want to move the data (meaning remove it from the original sheet), or just copy it to the other sheets (and leave the original list intact)?

I know what you mean. Or maybe a simple step could be made, for those row numbers, I can move them to Sheet2 instead.

For your second question, I think copy it to another sheet would be better.

Cheers.

 

[Joe4]

OK, try something like this:

Sub MyCopy()

    Dim r As Long
    Dim mn As Long, mx As Long
    Dim snum As Long, slet As Long
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    
    Application.ScreenUpdating = False
    
'   Initialize values
    Set ws1 = Sheets("Sheet1")  'THIS IS THE DATA SHEET
    Set ws2 = Sheets("Sheet2")  'THIS IS THE ROW NUMBER SHEET
    snum = 0
    slet = 96
    
'   Loop through G1:G26
    For r = 1 To 25
'       Create new sheet name
        snum = r Mod 10
        Select Case snum
            Case 0
                snum = 10
            Case 1
                slet = slet + 1
        End Select
'       Add Sheet and Name
        Sheets.Add After:=Sheets(Sheets.Count)
        Set ws3 = ActiveSheet
        ws3.Name = Chr(slet) & snum
'       Determine rows to copy
        mn = ws2.Cells(r, "G") + 1
        mx = ws2.Cells(r + 1, "G") - 1
'       Copy rows over to new sheet
        ws1.Rows(mn & ":" & mx).Copy ws3.Range("A1")
    Next r
        
    Application.ScreenUpdating = True
    
    MsgBox "Copy complete!"
    
End Sub

Note that is there is some way to determine whrere the line breaks should be, just by looking at the data, we may be able to eliminate the need for Sheet2 altogether.

 

[ffffff]

OK, try something like this:

Sub MyCopy()

    Dim r As Long
    Dim mn As Long, mx As Long
    Dim snum As Long, slet As Long
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    
    Application.ScreenUpdating = False
    
'   Initialize values
    Set ws1 = Sheets("Sheet1")  'THIS IS THE DATA SHEET
    Set ws2 = Sheets("Sheet2")  'THIS IS THE ROW NUMBER SHEET
    snum = 0
    slet = 96
    
'   Loop through G1:G26
    For r = 1 To 25
'       Create new sheet name
        snum = r Mod 10
        Select Case snum
            Case 0
                snum = 10
            Case 1
                slet = slet + 1
        End Select
'       Add Sheet and Name
        Sheets.Add After:=Sheets(Sheets.Count)
        Set ws3 = ActiveSheet
        ws3.Name = Chr(slet) & snum
'       Determine rows to copy
        mn = ws2.Cells(r, "G") + 1
        mx = ws2.Cells(r + 1, "G") - 1
'       Copy rows over to new sheet
        ws1.Rows(mn & ":" & mx).Copy ws3.Range("A1")
    Next r
        
    Application.ScreenUpdating = True
    
    MsgBox "Copy complete!"
    
End Sub

Note that is there is some way to determine whrere the line breaks should be, just by looking at the data, we may be able to eliminate the need for Sheet2 altogether.

It works, thank you so much.
Yeah. True, I am trying to put line break now.

Thank you anyway!!! It really helps.