PDA

View Full Version : [SOLVED] splitting a range to a variable number



adygelber
06-26-2014, 06:12 AM
Hello all,

I have to split a range (with a variable number of rows and a fixed number of columns) to a variable number of persons (stated in a column from another worksheet).
Basically, in Sheet1 I have in column B a list of names (for example: B3="A", B4="B", B5="C"). Can be a list of 3 names, 4 names or any number of names.

In Sheet2 I have a range of data which has 12 columns and a variable number of rows.

Now, I want to divide equally the rows from Sheet2 to the names from Sheet1.Column B, by creating a new WorkSheet for every name.

For example: If I have 3 names and in Sheet2 a range of data with 10 rows and 12 columns, I want to create 3 new WorkSheets (one for every name) and in every WorkSheet I want to have an equal number of rows, as following:

Sheet Name1: rows 1-4
Sheet Name2: rows 5-7
Sheet Name3: rows 8-10

By this way I splitted the list equally to the 3 names and the first name receives an extra row because 10 Mod 3 is 1, therefore remains a row undistributed.

Can anyone help me with an idea of how to write this in VBA? I tried with two FOR loops but I didn't manage to configure them properly.

Thank you in advance!

Bob Phillips
06-26-2014, 06:25 AM
Public Sub SplitData()
Dim lastrow As Long
Dim lastrow2 As Long
Dim nextrow As Long
Dim numrows As Long
Dim copyrows As Long
Dim remain As Long
Dim i As Long

Application.ScreenUpdating = False

With Worksheets("Sheet2")

lastrow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

With Worksheets("Sheet1")

lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
numrows = lastrow2 \ (lastrow - 1)
remain = lastrow2 - (numrows * (lastrow - 1))
nextrow = 1
For i = 2 To lastrow

Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = .Cells(i, "B").Value
copyrows = numrows + IIf(remain > 0, 1, 0)
remain = remain - 1
Worksheets("Sheet2").Rows(nextrow).Resize(copyrows).Copy ActiveSheet.Rows(1)
nextrow = nextrow + copyrows
Next i
End With

Application.ScreenUpdating = True
End Sub

adygelber
06-29-2014, 11:35 PM
Thanks a lot!