---

Sub SplitTableToFilesTest10()
    Dim wsSource As Worksheet
    Dim wbNew As Workbook
    Dim lastRow As Long, r As Long, countSaved As Long
    Dim savePath As String
    Dim fileName As String
    Dim uchastok As String, address As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wsSource = ActiveSheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    savePath = ThisWorkbook.Path & "\Тест_10_файлов\"
    
    If Dir(savePath, vbDirectory) = "" Then MkDir savePath
    
    countSaved = 0
    
    For r = 2 To lastRow
        ' Проверяем, что строка не пустая и не служебная
        If wsSource.Cells(r, "B").Value <> "" And Not wsSource.Cells(r, "B").Value Like "*КРАСН*" Then
            uchastok = wsSource.Cells(r, "D").Text
            address = 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, "|", "_")
            
            ' Создаем новую книгу
            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
            
            ' Сохраняем и закрываем
            wbNew.SaveAs fileName:=savePath & fileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
            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 & " тестовых файлов в папке 'Тест_10_файлов'", vbInformation
End Sub