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