# How To Split One Excel Sheet To Many Based On Conditions?

#### xlmaniac

##### Well-known Member
Dear All,
I do have a master Sheet Named DUMP which have 10 Columns in it. The sample is as follows across A1:J9
I want to create multiple sheets from this dump sheet based on the following conditions:-

1)Number of sheets will be based on the Unique Count of DCs(Under Column:-F). Here in this scenario, the no of sheets will be 4 since there are 4 Unique count of DC Codes under Column:-F.
2)Each populated Excel Sheets will also have the same sequential Column Headers as present in the DUMP Sheet & further it should have the details only pertaining to the DC Codes.
3)Sheet Names will be based on the DC Codes(Column:-F).
4)Finally, in every populated Excel Sheet, the qty needs to be sorted on the descending order(Column:-I).

Pls help.
Input:-
 Delivery SKU Article Description PGr Created on DC Ship-to STO Number Qty Value q 1 1q z 25-Jan a z 10 2 100 w 2 2w x 26-Jan b x 20 3 200 e 3 3e c 27-Jan c c 30 4 300 r 4 4r v 28-Jan d d 40 5 400 t 5 5t b 29-Jan a e 50 6 500 y 6 6y n 30-Jan a r 60 7 600 u 7 7u n 30-Jan b t 70 8 700 i 8 8i m 30-Jan c y 80 9 800

Desired ResultOne Sheet for DC:-a)(Sheet Name=a)
 Delivery SKU Article Description PGr Created on DC Ship-to STO Number Qty Value y 6 6y n 30-Jan a r 60 7 600 t 5 5t b 29-Jan a e 50 6 500 q 1 1q z 25-Jan a z 10 2 100

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

#### JLGWhiz

##### Well-known Member
See if this will do what you want.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
With sh
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
.Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
If c <> "" Then
.UsedRange.AutoFilter 6, c.Value
ActiveSheet.Name = c.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
.AutoFilterMode = False
End If
Next
.Cells(lr + 2, 1).CurrentRegion.ClearContents
End With
End Sub

#### mart37

##### Well-known Member
Maybe you can use a pivot table.
It is possible to make from one pivot table all the other sheets.
In the pivot table you place DC in the section FILTERS.
Now you can create sheets for every DC with the option: Show Report Filter Pages

#### xlmaniac

##### Well-known Member
See if this will do what you want.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
With sh
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
.Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
If c <> "" Then
.UsedRange.AutoFilter 6, c.Value
ActiveSheet.Name = c.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
.AutoFilterMode = False
End If
Next
.Cells(lr + 2, 1).CurrentRegion.ClearContents
End With
End Sub
Thanks a lot for your time and support towards solving my issue. Really appreciate the same.
The solution is yielding the desired result but the qty is not sorted n the descending order in each of the sheets.(Column:-I).
Pls help to get this sorted.
Regards
Xlmaniac

#### JLGWhiz

##### Well-known Member

Yep, missed that. Here it is.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
With sh
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
.Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
If c <> "" Then
.UsedRange.AutoFilter 6, c.Value
ActiveSheet.Name = c.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
.AutoFilterMode = False
End If
Next
.Cells(lr + 2, 1).CurrentRegion.ClearContents
End With
End Sub

#### xlmaniac

##### Well-known Member
Yep, missed that. Here it is.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
With sh
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
.Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
If c <> "" Then
.UsedRange.AutoFilter 6, c.Value
ActiveSheet.Name = c.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
.AutoFilterMode = False
End If
Next
.Cells(lr + 2, 1).CurrentRegion.ClearContents
End With
End Sub
Absolutely amazing!!
Thanks a lot for your time & effort.
Pls accept sincere gratitude.
This will be a real time saver.

#### JLGWhiz

##### Well-known Member
Absolutely amazing!!
Thanks a lot for your time & effort.
Pls accept sincere gratitude.
This will be a real time saver.
You;re Welcome,
Regards, JLG

Replies
6
Views
210
Replies
0
Views
127
Replies
1
Views
471
Replies
0
Views
82
Replies
3
Views
68

### Forum statistics

1,129,685
Messages
5,637,809
Members
416,983
Latest member
LessThanAverageUser

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back