Presuň kód z List1 do ThisWorkbook a takto ho uprav:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim aRow As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each aRow In Worksheets("Sortiment").Range("E:E").Rows
        If aRow = "A" Then
            aRow.EntireRow.Copy
            Worksheets("Prodáno").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            aRow.EntireRow.Delete
        End If
    Next aRow
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub