Option Explicit
' make sure to make a backup of your master sheet before running this
' i would also put a bunch of error checking in this
Public Sub DeleteAndCopyProductionSheets()
Const prodDirectory As String = "C:\ProductionWorkbooks\" ' where you want the new workbooks to go
Dim wb As Workbook, newWorkbook As Workbook
Dim ws As Worksheet
Dim tbl As ListObject
Dim wbName As String
Dim i As Integer, x As Integer, iwfIndex As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
' get all your production names from the table
Set tbl = shMaster.ListObjects("tblProduction") ' this is your table of numbers, production units change prior running
Set wb = ThisWorkbook
For i = 1 To tbl.ListRows.Count
wbName = tbl.ListRows(i).Range(, 1).Value
' delete the existing workbooks
If Dir(prodDirectory & wbName) <> "" Then
Kill prodDirectory & wbName
End If
' find IWF EXTRACT
iwfIndex = ReturnWSheetIndexByName(wb, "IWF EXTRACT")
' create a new, blank workbook
Set newWorkbook = Workbooks.Add
If iwfIndex > 0 Then
wb.Activate
wb.Worksheets(iwfIndex).Copy Before:=newWorkbook.Sheets(1)
newWorkbook.Sheets("Sheet1").Delete
End If
' now try to find the worksheet with the wbName...Note this will match the first tab with the name in the sheet name
iwfIndex = ReturnWSheetIndexByInstr(wb, wbName)
If iwfIndex > 0 Then
wb.Activate
wb.Worksheets(iwfIndex).Copy After:=newWorkbook.Sheets(1)
End If
' save the new workbook with the specified name
newWorkbook.SaveAs prodDirectory & wbName, FileFormat:=52
newWorkbook.Close SaveChanges:=True
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Set wb = Nothing
Set ws = Nothing
Set tbl = Nothing
End Sub
Private Function ReturnWSheetIndexByName(wb As Workbook, sheetName As String) As Integer
Dim i As Integer
wb.Activate
For i = 1 To Worksheets.Count
If Worksheets(i).Name = sheetName Then
ReturnWSheetIndexByName = i
Exit Function
End If
Next
ReturnWSheetIndexByName = -1
End Function
Private Function ReturnWSheetIndexByInstr(wb As Workbook, sheetName As String) As Integer
Dim i As Integer
wb.Activate
For i = 1 To Worksheets.Count
' Check if sheet name contains the specified substring
If InStr(1, Worksheets(i).Name, sheetName, vbTextCompare) > 0 Then
ReturnWSheetIndexByInstr = i
Exit Function
End If
Next
ReturnWSheetIndexByInstr = -1
End Function
