---

Sub SplitTableToFilesTest10()
    Dim wsSource As Worksheet
    Dim wbNew As Workbook
    Dim lastRow As Long, r As Long, countSaved As Long
    Dim baseFolder As String, savePath As String
    Dim fileName As String
    Dim uchastok As String, address As String
    Dim fso As Object
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wsSource = ActiveSheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    ' Если исходный файл не сохранен — сохраняем на Рабочий стол
    If ThisWorkbook.Path <> "" Then
        baseFolder = ThisWorkbook.Path
    Else
        baseFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    End If
    
    savePath = baseFolder & "\Тест_10_файлов\"
    
    ' Надежное создание папки
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(savePath) Then
        fso.CreateFolder savePath
    End If
    
    countSaved = 0
    
    For r = 2 To lastRow
        ' Проверяем, что строка не пустая и не служебная
        If Trim(wsSource.Cells(r, "B").Text) <> "" And InStr(1, wsSource.Cells(r, "B").Text, "КРАСН", vbTextCompare) = 0 Then
            uchastok = Trim(wsSource.Cells(r, "D").Text)
            address = Trim(wsSource.Cells(r, "F").Text)
            
            ' Формируем и полностью очищаем имя файла от запрещенных знаков и переносов строк
            fileName = "Участок_" & uchastok & "_" & address
            fileName = Replace(fileName, "/", "_")
            fileName = Replace(fileName, "\", "_")
            fileName = Replace(fileName, ":", "_")
            fileName = Replace(fileName, "*", "_")
            fileName = Replace(fileName, "?", "_")
            fileName = Replace(fileName, """", "_")
            fileName = Replace(fileName, "<", "_")
            fileName = Replace(fileName, ">", "_")
            fileName = Replace(fileName, "|", "_")
            fileName = Replace(fileName, vbCr, "")
            fileName = Replace(fileName, vbLf, "")
            fileName = Trim(fileName)
            
            If fileName = "Участок__" Or fileName = "" Then
                fileName = "Строка_" & r
            End If
            
            ' Создаем новую книгу
            Set wbNew = Workbooks.Add(xlWBATWorksheet)
            
            ' Копируем шапку и текущую строку
            wsSource.Rows(1).Copy wbNew.Sheets(1).Rows(1)
            wsSource.Rows(r).Copy wbNew.Sheets(1).Rows(2)
            
            ' Копируем ширину колонок
            wsSource.Rows(1).Copy
            wbNew.Sheets(1).Rows(1).PasteSpecial xlPasteColumnWidths
            Application.CutCopyMode = False
            
            ' Сохраняем в формате .xlsx (51 = стандартный формат книги Excel)
            wbNew.SaveAs fileName:=savePath & fileName & ".xlsx", FileFormat:=51
            wbNew.Close SaveChanges:=False
            
            countSaved = countSaved + 1
            
            ' Останавливаемся ровно после 10 файлов
            If countSaved >= 10 Then Exit For
        End If
    Next r
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Готово! Успешно создано " & countSaved & " файлов в папке:" & vbCrLf & savePath, vbInformation
End Sub