Solved

# How to split data in excel into equal groups? (excel vba)

Posted on 2016-10-28
Medium Priority
499 Views
Hi everyone,

I have a big amount of data in excel (many rows, many columns) and I need to devide it into equal groups. The main problem is that the amount of groups is something that I cannot predict, meaning that on day I need to split it into 12 groups other day into 15. Additionally, the amount of columns and rows also may change, depends on the kind of report we receive. What I need is macro(?) which will allow me to to devide data into separate tabs, but the amount of the tabs is something I need to choose. All data provided in the report need to move.

Is anyone able to help me?

Report.xlsx
0
Question by:Marta Wilczyńska
• 2

LVL 53

Expert Comment

ID: 41864083
Can you give an example of, or tell us how you want it divided up?
0

LVL 93

Accepted Solution

Patrick Matthews earned 2000 total points (awarded by participants)
ID: 41864391
This appears to do it.  Assumptions:
• Prompted for number tabs to split to at start
• If # of data rows is evenly divisible by # tabs, each tab will have same # rows
• If not, The first (n-1) tabs will have the same # rows, and the "extra" rows go to the nth tab

Option Explicit

Sub SplitToTabs()

Dim LastR As Long, LastC As Long
Dim SourceWs As Worksheet
Dim DestWb As Workbook
Dim DestWs As Worksheet
Dim NumOfTabs As Long
Dim NumDataRows As Long
Dim RowsPerTab As Long
Dim OldSheetsPerWb As Long
Dim Counter As Long
Dim RowsToCopy As Long
Dim StartCopyRow As Long

Set SourceWs = ActiveSheet
With SourceWs
LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
NumDataRows = LastR - 1

NumOfTabs = InputBox("You have " & NumDataRows & " data rows", "How many tabs to split into?", 1)
RowsPerTab = Int(NumDataRows / NumOfTabs)

OldSheetsPerWb = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = NumOfTabs
Application.SheetsInNewWorkbook = OldSheetsPerWb
StartCopyRow = 2

For Counter = 1 To NumOfTabs
Set DestWs = DestWb.Worksheets(Counter)
SourceWs.Cells(1, 1).Resize(1, LastC).Copy DestWs.Cells(1, 1)
If Counter < NumOfTabs Then
RowsToCopy = RowsPerTab
Else
RowsToCopy = LastR - StartCopyRow + 1
End If
SourceWs.Cells(StartCopyRow, 1).Resize(RowsToCopy, LastC).Copy DestWs.Cells(2, 1)
StartCopyRow = StartCopyRow + RowsToCopy
Next

End Sub
1

Author Comment

ID: 41871700
Patrick it works! Thank you very much
0

LVL 93

Expert Comment

ID: 41897212
0

## Featured Post

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.