Several Tabs in a workbook

[Kyosti]

I have a file that I was assisted on by @Fluff in the past. I am looking for a little bit of help. The macro that was created works perfectly and will split one table out into several tabs based on a specific name. What I need to do now is create an additional macro to create a completely separate workbook by tab named by the tab. The intent is that each tab will be mailed out to a specific user for each file. Can anyone help?

 

[JLGWhiz]

This assumes that Sheet Data is the only one that you do not want to make a file for, if there are more then the statement will need to be modified like 'And sh.Name <> Sheets("nextnotcopy"), 'nextnotcopy would be the actual sheet name in your file that you do now want a new file for.

Sub t()
Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Data" Then
            sh.Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sh.Name & ".xlsx" FileFormat:=51
            ActiveWorkbook.Close False
        End If
    Next
End Sub

 

[Kyosti]

@JLGWhiz so would I replace an area of the code, or add this to the code that is existing?

Existing Code: 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

 

[Kyosti]

Also I am getting a compile error on the macro you provided.

 

[JLGWhiz]

Also I am getting a compile error on the macro you provided.

Had a comma missing in the SaveAs line

Sub tx()
Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Data" Then
            sh.Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sh.Name & ".xlsx"[COLOR=#ff0000],[/COLOR] FileFormat:=51
            ActiveWorkbook.Close False
        End If
    Next
End Sub

The code is stand alone as posted, but if you want to include it in the other code, just delete the Sub... and End Sub line and paste the rest in between the End With and End Sub lines of the code Fluff gave you. BTW, when posting code, it helps if you use code tags to hold the formatting. Just highlight the code by selecting it with the mouse pointer and then click the pound symbol (#) in the tool bar of the reply box.

 

[Kyosti]

Worked like a charm!!! Thanks so much!!

 

[Kyosti]

@JLGWhiz

Last question if possible, I am sure it is possible, but I don't want to mess it up. Is there anyway to add the month and year to the name of the file when processing the Macro?

 

[JLGWhiz]

@JLGWhiz

Last question if possible, I am sure it is possible, but I don't want to mess it up. Is there anyway to add the month and year to the name of the file when processing the Macro?

Modify the line as shown in red font.

Sub tx()
Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Data" Then
            sh.Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sh.Name [COLOR=#b22222]& Format(Date, "-mm-yyyy")[/COLOR] & ".xlsx"[COLOR=#ff0000],[/COLOR] FileFormat:=51
            ActiveWorkbook.Close False
        End If
    Next
End Sub

 

[Kyosti]

I was sooo close, I thought it would be something like that but I did not know the language. THanks again

 

[JLGWhiz]

I was sooo close, I thought it would be something like that but I did not know the language. THanks again

You're welcome, regards, JLG