Split one table into multiple sheets based on criteria

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,541
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Kyosti

Board Regular
Joined
Jun 2, 2008
Messages
84
@Fluff, You helped me before I hope you can help me again. I have listed below the macro as it stands today. Is there anyway that the macro after splitting the tabs out, can create its own individual file based on the tab name?

Sub VendorSplit()
'
' VendorSplit Macro
'
Dim Cl As Range
Dim WS As Worksheet
Dim Ky As Variant

Columns("E:E").Select
Selection.Replace What:="FULL ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="TPP", Replacement:="TRANSFER", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select

Set WS = Sheets("Data")
With CreateObject("scripting.dictionary")
For Each Cl In WS.Range("O2", WS.Range("O" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl
For Each Ky In .Keys
WS.Range("A1:O1").AutoFilter 15, Ky
Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
WS.AutoFilter.Range.SpecialCells(xlVisible).EntireRow.Copy Range("A1")
Next Ky

Dim Wsht As Worksheet
For Each Wsht In Worksheets
With Wsht.UsedRange
.EntireColumn.AutoFit
End With
Next Wsht

Range("A1").Select
Sheets("Data").Select
Range("DataTable[[#Headers],[Original Producer Number]]").Select
ActiveSheet.ListObjects("DataTable").Range.AutoFilter Field:=15
ActiveWindow.SmallScroll Down:=-30

Cells.Select
Selection.ColumnWidth = 14
Range("DataTable[[#Headers],[Original Producer Number]]").Select

For i = 1 To Application.Sheets.Count
For j = 1 To Application.Sheets.Count - 1
If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
Sheets(j).Move after:=Sheets(j + 1)

Sheets("Data").Select
Sheets("Data").Move Before:=Sheets(1)

End If
Next
Next
End With
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,541
Office Version
365
Platform
Windows
As this is now a totally different question, please start a new thread.
Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,095,322
Messages
5,443,785
Members
405,251
Latest member
shanezer

This Week's Hot Topics

Top