....
and Name like '%BMW%'
.......

Sub FillWorkbookProperties(ByRef wb As Workbook, _
                           Optional ByVal Title As String = vbNullString, Optional ByVal Subject As String = vbNullString, _
                           Optional ByVal Author As String = vbNullString, Optional ByVal Keywords As String = vbNullString, _
                           Optional ByVal Template As String = vbNullString, Optional ByVal LastAuthor As String = vbNullString, _
                           Optional ByVal Manager As String = vbNullString, Optional ByVal Company As String = vbNullString)
    
     
     
    On Error Resume Next
   
 
 
    With wb.BuiltinDocumentProperties
        If Len(Title) Then .Item(1) = Title
        If Len(Subject) Then .Item(2) = Subject
      '  If Len(Author) Then .Item(3) = Author
       ' If Len(Template) Then .Item(4) = Template
       ' .Item(5) = MyComment
      '  If Len(LastAuthor) Then .Item(7) = LastAuthor
        'If Len(Manager) Then .Item(20) = Manager
        If Len(Company) Then .Item(21) = Company
    End With
End Sub



Sub ПримерИспользования_FillWorkbookProperties()
    FillWorkbookProperties ActiveWorkbook, "Test1", , , , , , , Company
End Sub

'Сохраняем файл
   ActiveWorkbook.SaveAs Filename:=FinalFileName, _
                      FileFormat:=xlOpenXMLWorkbook
                      'FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Для сохранения файла с макросом

   'Включаем вывод сообщений
   Application.DisplayAlerts = True

   'Сообщение с результатом выполнения процедуры
   MsgBox "Файл успешно сохранен с названием - " & CellValue, vbInformation, "Результат"

Repaired Records: Formula from /xl/worksheets/sheet1.bin part

Private Sub CommandButton1_Click()
If Len(TextBox1.Text) = 0 Or Len(TextBox2.Text) = 0 Then
MsgBox "Заполнены не все поля!", vbCritical
Exit Sub
End If
If IsNumeric(TextBox2.Value) = False Then
MsgBox "В поле Вес должно быть введено числовое значение!", vbCritical
Exit Sub
End If
With Sheets("sheet1")
If .Columns(1).Find(TextBox1.Text, , xlValues, xlWhole) Is Nothing Then
  .Rows("2:2").Insert Shift:=xlDown
     '.Rows("2:2").Insert Shift:=xlDown
  .Cells(2, 1) = TextBox1.Value
  .Cells(2, 2) = TextBox2.Value
  Else
  MsgBox ("Уже есть"), vbCritical, "Сообщение": Exit Sub
  End If
End With
Unload Me
MsgBox "Успешно добавлено!", vbInformation
End Sub

Private Sub CheckBox1_Click()
If Sheets("test").Range("k1").Value = "1" Then
CheckBox1.Value = TrueIf Sheets("test").Range("k1").Value = "0" Then
CheckBox1.Value = False
End If
End If

Private Sub Worksheet_Change(ByVal Target As Range)     If Cells(6, 5).Text = test1 Then
         Rows("22:24").Hidden = True
     Else
       
         Rows("22:24").Hidden = False
     End If
End Sub

=VLOOKUP(K8,test,2,0)