Demo for first 2 products. Amend i to suit.
Option Explicit
Sub MakeProducts()
Dim wb As Workbook
Dim wbCopy As String
Dim sh As Worksheet
Dim sht As Worksheet
Dim Lr As Long
Dim Prod As Long
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set sh = Sheets("Products")
For i = 2 To 3 'Sh.Cells(Rows.Count, 1).End(xlUp).Row
Prod = sh.Cells(i, 1).Value
wbCopy = ActiveWorkbook.Path & "\" & Prod & ".xlsm"
ActiveWorkbook.SaveCopyAs wbCopy
Set wb = Workbooks.Open(wbCopy)
With wb
For Each sht In .Sheets
For j = sht.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If sht.Cells(j, 1) <> Prod Then sht.Rows(j).Delete
Next j
Next sht
Call DelCode(wb)
wb.Close True
End With
Next i
Application.ScreenUpdating = True
End Sub
Sub DelCode(wb)
Dim x
On Error Resume Next
With wb.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With
On Error GoTo 0
End Sub