Sub Proverit()

    Dim myArrAvt(0 To 50) As Variant, sMerge As Variant
    Dim i As Integer, ii As Integer, n As Integer, PosStr As Integer
    Dim LDBname1 As String
    Dim Element As String
    n = 24

    Element = Worksheets("EXCEL").Cells(n, 11)
    PosStr = Cells(24, 1).End(xlDown).Row
    For n = 24 To PosStr
    
If Worksheets("EXCEL").Cells(n, 11) <> "4" Then
   LDBname1 = Worksheets("EXCEL").Cells(n, 2)
    ii = ii + 1: i = ii
      myArrAvt(ii) = Worksheets("EXCEL").Cells(n, 11)
    If ii < 50 Then
        If ii = 1 Then
         sMerge = myArrAvt(ii)
            Else
    For i = 1 To i
    If Element <> myArrAvt(ii) Then sMerge = sMerge & ", " & myArrAvt(i)
    Next i
        End If
        
    End If
End If
    Next n
End Sub

'---------------------------------------------------------------------------------------
' Module    : Module3
' Author    : diam
' Date      : 26.06.2020
' Purpose   :
'---------------------------------------------------------------------------------------
Const mdlName As String = "Module3"

Public Sub SaveFile()

   'Объявление переменных
   Dim CellValue As String
   Dim Path As String
   Dim FinalFileName As String

   'Временно отключаем показ вспомогательных сообщений
  Const prcName As String = "SaveFile"
  On Error GoTo ErrHandler
  
   Application.DisplayAlerts = False

   'Задаём каталог сохранения файла (в данном случае текущий каталог)
   
    Path = Worksheets("Листы").Cells(19, 8)
   
   'Проверка значения ячеек B14 и D14
   If Worksheets("EXCEL").Cells(8, 10) = "" Or Worksheets("EXCEL").Cells(9, 10).Value = "" Then
     MsgBox "В ячейке отсутствует значение", vbCritical, "Ошибка!"
     Exit Sub
   End If
   
   'Получаем значение ячейки
   'CellValue = Worksheets("EXCEL").Cells(8, 10).Value & " " & Worksheets("EXCEL").Cells(9, 10).Value
    CellValue = "TO" & Worksheets("EXCEL").Cells(14, 10).Value
   'Формируем итоговый путь и название файла
   FinalFileName = Path & CellValue & ".xlsx"

   'Сохраняем файл
      ActiveWorkbook.SaveAs Filename:=FinalFileName, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   
   '
                      'FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Для сохранения файла с макросом
   'Включаем вывод сообщений
   Application.DisplayAlerts = True

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

Success:

mEx:
  Exit Sub

ErrHandler:
  Application.DisplayAlerts = True
  ErrorSave mdlName, prcName, Err.Number, "(" & Err.Description & ")" & vbCrLf & "в процедуре " & prcName & " of Module " & mdlName & " в строке " & Erl
  Resume mEx
  Resume

  End Sub